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SECTION  I 
INTRODUCTION 

Argonne  National  Laboratory  (ANL)  has  developed  an  Air  Quality 
Assessment  Model  (AQAM)  for  airbase  operations  under  contract  to  the  U.S. 

Air  Force  Civil  Engineering  Center  (AFCEC)  designed  to  simulate  the  emission 
of  pollutants  from  sources  on  an  airbase  and  the  dispersion  of  these  emissions 
in  the  atmosphere  so  as  to  enable  calculation  of  pollutant  concentrations  over 
a grid  of  ground  level  receptors.  These  models  are  comprised  of  four  physically 
separate  computer  codes,  of  which  three  must  be  operated  by  the  user.  The 
fourth  code  prepares  a magnetic  tape  containing  long  term  stability-time-wind 
roses  for  use  by  the  long  term  climatological  type  air  pollution  model.  This 
code  is  operated  on  request  by  the  USAF  Environmental  Technical  Applications 
Center  in  Washington,  D.C.  and  the  resultant  magnetic  tapes  containing  the 
climatological  information  is  shipped  to  the  user.  The  other  three  codes, 
developed  by  ANL,  consist  of  the 

• Source  Inventory  Model  (SRCINV) 

• Short  Term  Emission/Dispersion  Model 

• Long  Term  Emission/Dispersion  Model 

This  report  constitutes  the  computer  code  documentation  for  the  second 
of  these  - the  Short  Term  Emission/Dispersion  Model.  A separate  computer  code 
documentation  manual  (Reference  1)  is  available  for  SRCINV.  Documentation 
for  the  Long  Term  Emission/Dispersion  Model  is  currently  being  prepared  and 
will  be  available  shortly.  A companion  document  to  these  reports  - Operator’s 
Guide  (Reference  2)  of  the  Air  Quality  Assessment  Model  for  airbase  operations  - 
consists  of  a detailed  discussion  of  the  various  functional  parts  of  the 
computer  programs  and  the  input/output  requirements.  A second  companion  report 
(Reference  3)  discusses  the  technical  and  theoretical  basis  underlying  AQAM  and 
presents  and  describes  equations  and  algorithms  used  in  the  various  AQAM  sub- 
models . 

The  intended  purpose  of  the  present  document  is  to  provide  a computer 
programmer  with  sufficient  information  so  that  he  can  study  the  code  and  make 
changes  or  modifications  to  it  where  required. 
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Table  1 contains  a list  of  all  routines  contained  in  the  Short  Term 
Model  in  alphabetical  order  together  with  a brief  description.  More  detailed 
descriptions  of  each  routine,  together  with  flow  charts  and  computer  code 
listings  with  comments  that  are  intended  to  link  listings  to  flow  charts, 
are  given  on  subsequent  pages.  It  is  hoped  that  this  information,  when 
combined  with  that  given  in  References  1,  2,  and  3,  will  enable  a programmer 
to  understand  and  make  changes  to  the  code  when  desired. 


Schematic  Flow  Diagram  of  SI 
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TABLE  1.  LIST  OF  ALL  PROGRAMS  AND  SUBPROGRAMS 
IN  THE  SHORT  TERM  EMISSION/DISPERSION  MODEL 


SUBROUTINE 

ABARAR 

ABLNAR 

ABPTAR 

ACSRCE 

AINE 

BLOCK  DATA 
CAVL 

CLASSE 

DEPART 

DIFERF 

EMISAR 

ENARAY 

INDINP/DEPINP 

MAIN 

MAINS 

ME1HA- 

METHE 

OUTPUT 

PLRISE 

POLSOR 


DESCRIPTION 


Input  airbase  non-aircraft  area  source  data  from  master 
source  tape  and  compute  emissions  rates. 

Input  airbase  non-aircraft  line  source  data  from  master 
source  tape  and  compute  emission  rates. 

Input  airbase  non-aircraft  point  source  data  from  master 
source  tape  and  compute  emission  rates. 

Set  lip  the  aircraft  source  arrays  and  allocate  emissions 
to  areas  and/or  lines. 

Translate  line  and  receptor  coordinates  and  set  all 
necessary  line  parameters. 

Initialize  data  in  coiranon  blocks. 

Compute  coupling  coefficient  at  a receptor  due  to  a 
line  source. 

Print  input  error  message. 

Calculate  points  in  the  departure  path. 

Find  the  difference  between  two  error  functions. 

Accumulate  emissions  from  airbase  areas  and  lines. 

Input  envirpn  source  data  from  master  source  tape  and 
compute  emission  rates. 

Print  the  source  input. 

Read  general  data  and  direct  control  to  READ  and  MAINS. 
Main  driver  for  short  term  model. 

Calculate  diurnal  emissions  from  non -aircraft  sources 
using  varying  methods. 

Print  pollutant  concentrations  at  all  receptors. 

Calculate  effective  height  and  dispersion  coefficients 
for  a stack  plume. 

Direct  calls  to  the  proper  diffusion  routine  for  all 
input  sources. 
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TABLE  1.  LIST  OF  ALL  PROGRAMS  AND  SUBPROGRAMS  IN 
THE  SHORT  TERM  EMISSION/DISPERSION  MODEL  (CONCLUDED) 


PSEUDO 

Call  functions  to  find  virtual  distance  from  source  to 
pseudo  upwind  point. 

QMOD 

Compute  linear  distribution  of  pollution  along  a runway. 

READ 

Read  master  source  tape. 

RISE 

Calculate  plume  rise. 

RRDIST 

Calculate  length  of  runway  necessary  for  takeoff. 

SIGY/SIGCY 

Calculate  horizontal  dispersion  or  corresponding  virtual 
distance . 

SIGZ/SIGCZ 

Calculate  vertical  dispersion  or  corresponding  virtual 
distance. 

SOURCE 

Driver  for  non-aircraft  emission  routines. 

STPOL1 

Determine  pollutant  concentrations  from  point  and  area 
sources . 

STPOL2 

Determine  pollutant  concentrations  from  line  sources. 

TRAN 

Calculate  the  coupling  coefficient  at  a receptor  due  to 
a point  or  area  source. 

JI.JPJWIUI.  . 


Purpose: 


Input: 


Output: 


SUBROUTINE  ABARAR 


1.  To  read  from  the  master  source  type  all  data  needed  to 
define  airbase  non-aircraft  area  sources. 

2.  To  compute  the  emission  rates  due  to  evaporative  hydrocar- 
bons, space  heating,  off- road  vehicles,  and  military  and 
civilian  vehicles. 


If  the  diurnal  distribution  cards  are  input,  an  additional 
parameter,  IOPT,  is  read  here  to  choose  the  method  of  distri- 
bution of  those  evaporative  hydrocarbons  not  using  the  default 
of  a uniform  distribution. 


The  array,  ABAR,  is  filled  with  geometry  and  emission  data  for 
airbase  non- aircraft  area  sources. 


Subroutines 

Called: 


METHA,  METHB,  METHC,  METHE,  EMISAR 


SUBROUTINE  ABARAR 


- - 





* 


SUBFCUIINE  ABARAP 

TIHS  FOUTINE  COMPUTES  THE  EMISSION  RATES  FOR 
AIL  AIRbASE  AREAS 

NWRK  = NO.  OF  HYDROCARBON  WORKING  LOSSES 

NB  FT  = NC.  OF  HYDROCARBON  BREATHING  LOSSES 

NXEVP  = NO.  OF  OTHER  EVAPORATIVE  HYDROCARBON  SOURCES 

NSHS  = NO.  OF  SPACE  HEATING  SOURCES 

NCRVHS  = NO.  OF  OFF-ROAD  VEHICLE  SOURCES 

NMVHAR  = NO.  OF  MILITARY  VEHICLE  AREA  SOURCES 

NCVHAR  = NO.  OF  CIVILIAN  VEHICLE  AREA  SOURCES 

CCMMCN  /PERIOD/  IMONT H , NO  DAYS , ID AY, IH R 1 , IHR2 , 1 FL AG, JFLAG 
CCMMCN  / DEFALT  / IT  APE, ACLN DY , ACLNDZ, ALPH A (7)  , BET A ( 7)  , FLDE NS  (7) 
COMMON  /DSTRB1/  ACMO ( 1 3, 8)  , ACD Y (2 , 8)  , ACHR  (24 , 8)  , VHMLMO  ( 1 3)  , 

. VH  M1DY  (2)  , VHMLHR  (24)  ,CVABMO(13)  ,CVA6DY(2)  ,CVABHR(24)  ,CVENMO(13)  , 
. CVENDY  (2) , CVEN HR (24)  , FLMO  (13,7)  , FLDY  (2,7) ,FLHE(24, 7)  ,NC1 
CCMKC  N/JU  NK/D A Y S,LSRCE,NSPCE,SORCE(17,300)  ,SORGM  (10,200) 

. ,LCC1 ,LOC2 ,NGECM, IPT 

COMMON/ MO NHET/TMBAR,WSM9AR, AMD MB R,DTMBAR 

CCMMCN  /SRCE/  N PLTS , NENPT , NE N AR, N ENLN , N ABPT, N ABAR , N ABLN , 

. NACP1,NACAR,NACLN,ENFT(16,100)  , E NAR ( 1 1 , 1 00 ) , ENLN  (14,20)  , 

ABPT (16, 150)  , ABAR (11, 100) , ABLN  (14,  100) 
DIMENSION  ABARGM (7, 100) ,HCKRK  (10,59)  ,HCBRT(5,  100)  ,HCEVP(3,50)  , 

. FLHCUF (7)  , T VF  (7) 

EQUIVALENCE  (SORGM  ( 1 ) , ABA RGM ( 1 ) ) , (SORGM ( 70  1)  , HCWRK  ( 1) ) , 

. (SORGM  (1201) ,HCBET(1) ) , (SORGM  ( 1 70 1)  ,HCE VP  ( 1 ) ) 

LCC 1=2 
LCC2=2 
NGECM=0 
IFT  = 0 
NSRCE=0 

11  = 17 

1 2 = 3 C 0 

READ  (IT APE)  S A B AR , NTOT , NW P K, N B RT, NXE V P, NSHS , NOR VHS, 

NMVHAR, NCVHAR,NABAPS,  ( (ABARGM  (I,N)  ,1=1,7) , N= 1 , NAB AR)  , 

. ( (HCWRK  (I, N)  ,1=1,  10)  , N= 1 , NWF  K)  , 

. ((HCEFT(I,N) ,1=1,5)  ,h=1,NBFT) , 

( (HCEVP  (I  , N)  ,1=1,3)  ,N=1,  NXEVP)  , 

. ( (SCPCE  (I , N)  , 1 = 1 , NTCI)  , N = 1 , NABARS) 

IF  (NAEAR.FO.O)  GO  TO  1100 

NHI=IHF2 

IF  (IHR1.GT. IHP2)  NHI=24  + THR2 
H R S=  NHI -IHR1 ♦ 1 
DC  1C  N=1,NABAR 
DC  10  1=1 ,NFLTS 
AEAR (1+5, N) =0. C 
10  CONTINUE 

T=5./9.*(TN BAR- 32.0) +273. 

DC  20  J*  1 , 7 

I VP (J)  =EXP (ALPHA (J) -BETA  (J)/T) 

20  CCN1INUE 

IF  (NWRK.EQ.O)  GO  TO  100 

USING  DEFAULT  ACTIVITY  FRACTIONS  CALCULATE  HC 
EMISSIONS  FROM  ALL  FUELS  AND  SPILLAGE. 

ACCUMULATE  IN  ABAR  AR F AY 

DC  50  N= 1 , NWRK 


ABARFOOO 
ABA  PR 00  1 
ABARR002 
ABARROO  3 
ABAPP004 
ABARP005 
ABARR006 
ABARR007 
ABARR006 
ABARR009 
ABARRO 10 
ABARR01 1 
ABARRO 12 
ABARRO 1 3 
AB  AFR0 1 4 
ABARR015 
ABARR016 
ABARRO 17 
ABARR01 8 
ABARRO 19 
ABARR020 
ABARP021 
ABARP022 
ABARR023 
ABARR024 
AB A RR  025 
ABARF026 
ABARR027 
ABARR028 
ABARR029 
ABARP030 
ABARR03 1 
ABARR032 
ABARR033 
ABARR034 
ABARR035 
ABARR036 
ABAPR037 
ABARRO  3B 
ABARR039 
ABAPR040 
ABARR041 
ABARR042 
ABAPR043 
ABARR044 
ABARR045 
ABARP046 
ABARR047 
ABARR048 
ABARR049 
ABAPR050 
ABARR051 
ABARR052 
ABARR053 
ABARR054 
ABARR055 
ABARP056 
ABARR057 
ABARR058 
ABARP059 
ABARR060 
ABAPR06 1 


I 


HC=0. 

FFC=C. 

DC  40  J=1 ,7 
FLHOUF (J) =0 . 

DC  30  I=IHR 1 , NHI 
II=I 

IF  (I .GT. 24)  11  = 1-24 

FLHOUF  (J) =FLHOUR(J)  *FLHR (II, J) 

F LHOUB  (J)=FLHOOR(J)/HBS 

FFC=FRC*FLHOUR ( J) * PLHG  (IHONTH , J)  *FLDY (IDAY,J) 

HC=hC*HCBFK  (J*2  ,N)  *TVP(J)  *FLMO  (IMONTH, J ) * FL DY  (IDAY,  J) 

. *FLHOUR  (J)*7./DAYS 
CONTINUE 

F BC  = F FC/4 .*7. /DAYS 
J=HCNBK (2,N) 

ABAR(7,J)=ABAR(7,J)  ♦ (HC  ♦ HC  WRK  (10 , N)  * FRC)  * ( 1 . E+b/3 . 6) 
CONTINUE 

IF  (NERT.EQ.O)  GO  TO  200 

CALCULATE  HC  EHISSIONS  FROM  SPECIFIED  FUEL  AND 
TANK  TYPES.  ACCUMULATE  IN  ABAB  ARRAY 

DC  110  N=  1 , NBBT 
J = HCB FT  (3 , N) 

EX=0 . 68 

IF  (HCBBT  (4,N).EQ.  2.)  EX=0.70 

HC=HCBRT(5,N) * (TVP (J) / (14. 7-TVP(J) ) ) **LX*(1 • E*b/( J.b*24. *365.) ) 

J = HCBBT  (2,N) 

AEAB  (7, J) =ABAR (7,J)  *HC 
CONTINUE 

IF  (NXEVP.EQ.O)  GO  TO  300 

ICLASS=1 1C 

NTE  KP  = NPLTS 

NFLTS=1 

ICC  1 = 3 

NSECE=NABARS 
DC  210  N= 1 , NXEV  P 
DC  210  1=1,3 

SCBCE  (I,NABAFS+N)  = HCEVE(I,N) 

CCNTINUE 

ICPT=1 

IF  (JFLAG.EQ.O)  READ  2,IOPT 
FCBHAT  (14) 

GC  TC  (220,230) , IOPT 

CALL  HETHA (NXF.V P ,S08C  E , II  , 12,  ICL ASS) 

GC  TO  240 

CALL  HETHC (N XE V P ,SORC E , I 1 , 12, ICLASS) 

DC  250  N= 1 , NXEV F 

ACCUMULATE  OTHER  EVAPORATIVE  HC  EMISSIONS  IN  ABAR  ARRAY 
J = HCE  VP (2 , N ) 

ABAR  (7,J)  = ABAF  <7,J)  + SCRCE  (3,  N AB  A PS*  N) 

CCNTINUE 

NPLTS=NTEMP 

NSRCE=0 


ABARR062 
ABARR063 
AEARK064 
ABARR065 
ABARR066 
ABARR067 
ABARR068 
ABARR069 
ABARF070 
ABARF071 
APAFP072 
ABARR073 
ABARR07U 
ABARF075 
ABARF076 
ABARF077 
ABAFP078 
ABARP079 
ABAFR080 
ABAFE08 1 
ABARF082 
ABARFC83 
ABARP084 
ABAPP085 
ABA  PF086 
ABAFF087 
ABAFF088 
ABAFR089 
ABAFF090 
ABAPR091 
AB ARP092 
ABAPR093 
ABARR094 
AB AFP095 
ABAFF096 
ABARF097 
ABAPF099 
ABAFF099 
ABARR  100 
ABAFR101 
ABARP  102 
ABAFR  103 
ABAFF104 
A8ARR105 
APARF106 
ABAFF  107 
ABARF108 
ABAFF  109 
ABAPP110 
APARF 1 1 1 
ABAFR112 
ABAFP113 
ABAFF 114 
ABAFF 1 1 5 
ABA  PF  1 16 
ABARP  117 
ABARR  1 18 
ABAPP1 1 9 
ABARR  120 
ABAFF 12  1 
ABAFP122 
AB  A.  RP  1 ^ 3 
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n n n n n n n 


LCC1 = 2 

300  IF  (NSHS.EQ.O)  GO  TO  400 
ICL A SS= 1 1 1 

CALL  KETHB(NSHS,SORCE,I1,I2, I CLASS) 

400  IF  (NCRVHS. EQ. 0)  GO  TO  500 
ICLASS=112 

CALL  METHC (NOF VHS , SOPCE , 1 1 ,1 2 , IC LA SS) 

500  IF  (NBVhAF.EQ.O)  GO  TO  ^0 

CALL  METHE (NMVHAP, SOR<  '.iPILMO  , V HfiLDY  , VHBLH  R , 1 1 , 12 ) 

600  IF  (NCVHAR.  EQ.  0)  GO  TO  V.u, 

CALL  HETHE  (NCVHAR, SORCE,  JV ABMO, CV ABDY , CV ABHR, 1 1 , 12) 


♦♦♦♦EdlSSICNS  ARE  NOW  IN  BICROGRAMS/SEC 

FILL  ABAR  ARRAY  KITH  AREA  GEOBETRIES 

700  DO  710  N=1,NAE>AR 
DC  7 1 C 1=1,5 
A EAR  (I,N)=ABAFGM(I-f2,  N) 

710  CCNTINOE 


FILL  ABAR  ARRAY  WITH  THE  NON-FVAP  HC  EBISSION  DATA 


C 

C 

c 

c 


600 

900 

1CCC 

1100 


11=11 
12=100 
NSRCE  =0 
LCC 1 = 5 

IF  (NSHS.FQ.O)  GO  TO  800 
CALL  EBISAR  (NSHS, ABAR ,11,12) 

IF  (NOPVHS.  F.Q.O)  GO  TO  900 
CALL  EBISAR(NCFVHS, ABAR, II, 12) 

IF  (NBVHAR. EC. 0)  GO  TO  1000 
CALL  EBISAR  (NBVHAR,  AEAR, II, 12) 

IF  (NC  VH  A 0 . EC-0)  GO  TC  1100 
CALL  EBISAR  (NCVHAR , ABAR, II, 12) 

CCNTINOE 

RETURN 

END 


ABARR124 
ABARR 125 
ABARR126 
ABARR 127 
ABARR 128 
ABAPR129 
ABARR130 
ABARR131 
ABARP132 
ABARR  133 
ABARP134 
ABARR 135 
ABAPR136 
ABARR  137 
ABARR 1 38 
ABAPR139 
ABARR140 
ABARR  141 
ABARR  142 
ABARR143 
ABARR  144 
ABARR 145 
ABARR 1 46 
ABARR147 
ABARR 1 48 
ABARR 149 
ABARR150 
ABARR  15 1 
ABARF152 
ABARR 153 
ABA  RR 1 54 
ABARR155 
ABARR 156 
ABARR 1 57 
ABARR 158 
ABARR 159 
ABARR 160 
ABARR161 
ABARR  162 
ABA.RR163 
AB  ARP  1 64 
ABARR  165 
ABARR166 
ABARR 167 
ABARR168 
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SUBROUTINE  ABLNAR 


Purpose: 

1.  To  read  from  the  master  source  tape  all  data  needed  to 
define  airbase  non- aircraft  line  sources. 

2.  To  compute  the  emission  rates  due  to  military  and  civilian 
vehicle  line  and  other  airbase  line  activities. 

Input: 

If  the  diurnal  distribution  cards  are  input,  an  additional 
parameter,  IMETH,  is  input  here  to  choose  the  method  of  distri- 
bution of  emissions  from  those  other  airbase  line  activities 
not  using  the  default  of  a uniform  distribution. 

Output: 

The  array,  ABLN,  is  filled  with  geometry  and  emission  data  for 
non- aircraft  line  sources. 


Subroutines 

Called: 

METHA,  METHC,  METHE,  EMISAR 
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SUBROUTINE  ABLNAR 


READ  ITAPE  FOR  ALL  AIRBASE  LINE  SOURCE 
INPUT  AND  EMISSIONS  RESULTS,  TOGETHER  WITH 
TYPE  COUNTERS. 


noon 


SUBROUTINE  ABLNAR 

: THIS  ROUTINE  COMPUTES  THE  EHISSION  RATES  FOR  ALL 

: AIRBASE  LINES 

: NMVHLN  = NO.  OF  MILITARY  LINE  ACTIVITIES 

: NCVHLN  = NO.  OF  CIVILIAN  LINE  ACTIVITIES 

: NXLN  = NO.  OF  OTHER  AIR  BASE  LINE  ACTIVITIES 

COMMON  / DEFALT  / IT  APE, ACLN D Y, AC LNDZ , ALPH A (7)  , BET A ( 7)  , FLDENS (7) 
COMMON  /PERIOD/  IN ONT H, NOD AYS , IDAY , IHR1 , IHR2 , IFLAG, J FL AG 
COM MCN/J UNK/DA YS ,LSRCE,NSRCE,SORCE(17, 300)  , SORGM ( 10 , 200) 

. ,LOC1,LOC2, NGEOM,IPT 

COMMON  /DSTRET/  ACMO ( 1 3, 8)  , ACDY (2 , 8)  , ACHR (24, 0) , V HMLMO  (1 3) , 

. VHMLDY  (2) , VHMLHR  (24)  ,CVABMO(13)  , CVABD Y (2)  ,CVABHR (24)  ,CVE»MO(13) , 
. CVENDY (2) , CVENHR (24)  ,FLHO(13,7)  , FLDY  (2 , 7) , FLHR  (24 , 7)  ,NC1 
COMMON  /SPCE/  NPLTS,NENPT,NENAR, NENLN , N ABPT , N ABAR , NABLN, 

. NACPT,NACAR,NACLN , ENPT (16,100) , E NA R ( 1 1 , 1 00 ) , ENLN  ( 1 4 , 20) , 

. ABPT (16, 150) , ABAR (1 1, 100)  , ABLN (14,  100) 

LOC  1 = 2 

LOC2=2 

11  = 17 

12=300 

NGEOM=0 

IPT=0 

NSRCE=0 

FEAD(ITAPE)  NABLN, NTOT  ,NMVHLN , NCVHLN , NX LN , NAB LNS , 

((SORGM  (I, N)  ,1=1,  10)  ,N=1, NABLN)  , 

. ( (SCPCE  (I , N) ,1=1, NTCT) , N= 1 , NABLNS) 

IF  (NABLN. EQ.C)  GO  TO  600 
IF  (NMVHLN. EQ.O)  GO  TO  100 

CALL  MET  HE  (NMVH LN , SOP CE, V HMLMO, V HMLDY , VHMLH R , I 1 , 12) 

100  IF  (NCVHLN. EQ.O)  GO  TO  200 

CALL  METHE(NCVHLN,SORCE,CVABMO,CVABDY,CVABHR,I1,I2) 

200  IF  (NXLN. EQ.C)  GO  TO  300 
ICLASS=1 17 

I ME  TH  = 1 

IF  (JFLAG.EQ.O)  READ  1 , IM  ETH 
1 FORMAT  (14) 

GC  TO  (210,220)  , IM  ETH 

210  CALL  MFTHA  (NXLN, SORCE, 11,12, ICLASS) 

GC  TO  300 

220  CALI  METHC(NXLN, SORCE, II, 12, ICLASS) 

♦•♦♦EMISSIONS  ARE  NOW  IN  MICROGRAHS/SEC 

FILL  ABLN  ARRAY  WITH  LINE  GEOMETRIES 

3C0  DC  320  N=1, NABLN 
DC  310  1=1,8 
ABLN(I,N) =SORGH  (1*2, N) 

310  CONTINUE 

DC  320  I=1,NPLTS 
ABLN  (1*8, N) =0.0 
320  CONTINUE 


ABLNR000 
ABLNROO 1 
ABLNR002 
ABLNROO  3 
ABLNR004 
ABLNR005 
ABLNR006 
ABLNR007 
ABLNROO  8 
AELNR009 
ABLNP010 
ABLNR01 1 
ABLNPO 1 2 
ABLNR01 3 
ABLNRO 1 4 
ABLNRO 1 5 
ABLNRO 1 6 
ABLNP01 7 
ABLNRO 1 8 
ABLNP019 
ABLNP020 
ABLNR021 
ABLNR022 
ABLNP023 
AELNR024 
ABLNR025 
ABLNP026 
ABLNP027 
ABLNR028 
ABLNP029 
ABLNR030 
ABLNR031 
A.  BLNR032 
ABLNRO  3 3 
ABLNP034 
ABLNR035 
ABLNRO  36 
ABLNR037 
ABLNRO  38 
ABLNRO  39 
ABLNR040 
ABLNP04 1 
ABLNR042 
ABLNR043 
ABLNR044 
ABLNRO  4 5 
ABLNR046 
ABLNR047 
ABLNR048 
ABLNR049 
ABLNR050 
ABLNR051 
ABLNR052 
ABLNR053 
ABLNR054 
ABLNR055 
ABLNR056 
ABLNR057 
ABLNR058 
ABLNR059 
ABLNR060 
ABLNP06 1 


r>  o 


FILL  ABLN  ARRAY  WITH  LINE  ENISSION 

NSRCE=0 
LOC1=8 
11  = 14 
12=100 

IF  (NHVHLN. EC. 0)  GO  TC  400 
CALL  EHISAR(NNVHLN,ABLN,I1,I2) 

C 

400  IF  (NCVHLN. EQ. 0)  GO  TO  500 

CALL  EHISAR(NCVHLN,ABLN,I1,I2) 

C 

500  IF  (NXLN.EQ.O)  GO  TO  600 

CALL  EHISAR  (NXLN , ABLN , II , 12) 

C 

600  CONTINUE 
RETURN 
END 


DATA  ABLNR062 

ABLNR06  1 
APLNP064 
ABLNP065 
ABLNH066 
ABLNSC67 
ABLNR068 
ABLNR069 
ABLNPCO 
ABLNF071 
ABLNP072 
ABLNR073 
ABLNP074 
ABLNP075 
ABLNP076 

ABLNP077 

APLNR07B 

ABLNP079 
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SUBROUTINE  ABPTAR 


Purpose: 

1.  To  read  from  the  master  source  tape  all  data  needed  to 
define  airbase  non- aircraft  point  sources. 

2.  To  compute  the  emission  rates  due  to  training  fires,  test 
cells,  run-up  stands,  power  plants,  incinerators,  storage 
tanks  and  other  airbase  point  source  activities. 

Input: 

None 

Output: 

The  array,  APBT,  is  filled  with  geometry  and  emission  data  for 

airbase  non- aircraft  point  sources. 

Subroutines 

Called: 

METHA,  METHC,  METHD 


READ  ITAPE  FOR  ALL  AIRBASE  POINT  SOURCE 


INPUT  AND  EMISSIONS  RESULTS,  TOGETHER  WITH 
TYPE  COUNTERS. 


20 
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SUBROUTINE  ABPTAR 
C 

C THIS  ROUTINE  COMPUTES  THE  EHISSION  HATES  FOB  ALL 

C AIRBASE  POINTS 

C NTFS  = NO.  OP  TRAINING  FIRE  SITES 

C NTCS  = NO.  OF  TEST  CELIS 

C NRUS  = NO.  OF  RUN-UP  STANDS 

C NFFS  = NC.  OF  POWER  PLANTS 

C NICS  = NO.  OF  INCINERATORS 

C NETS  = NO.  OF  STORAGE  TANKS 

C NXS  = NO.  OF  OTHER  AIRBASE  POINT  SOURCES 

C 

COMMON /JUNK/DAYS,LSRCE,NSRCE,SCRC£( 17, 3C0) , SORGM (10,200) 

. ,LOC1,LOC2,NGEOM, IPT 

CCMHCN  / DEFALT  / IT  APE, ACLN DX , ACLNDZ , ALPH A ( 7)  , BET A ( 7)  , FL DE NS ( 7) 
COMMON  /SRCE/  N PLTS  ,NENPT  , NF  NA  H,  NE  NLN , N ABP1  , N At)  AR  , N Ad  L N , 

. NACPT,NACAR,NACLN , ENFT  (16, 100)  ,ENAR(11,  100)  , ENLN  (14,20)  , 

. ABFT  (16, 150) , ABAR ( 1 1, 100) , A BLN ( 1u,  100) 

LCC1= 10 
LCC2=1 1 
NGEOM  = 9 

I FT=  1 
NSRC  E=  0 

II  = 16 
12=200 

READ  (ITAPE)  NABP T, NTOT , NTFS , NTCS, NRUS , NPPS, NI CS , NSTS , N XS , 

( (SCRCE  (I  ,N)  ,1=1 , NT  CT)  , N= 1 , NABPT) 

C 

IF  (NABPT. EC. 0)  GO  TO  700 
IF  (NTFS.EQ.0)  GO  TO  100 
ICL A SS  = 1 0 1 
C 

CALL  METHC(NTFS,ABPT, 11,12, IC LASS) 

C 

100  IF  (NTCS.EQ.O)  GO  TO  200 
ICLASS=102 
C 

CALL  BETHC(NICS,ABPT,I1,I2,ICLASS) 

C 

200  IF  (NRUS.EQ.O)  GO  TO  300 
ICLASS=103 
C 

CALL  METHC(NRUS,ABPT, 1 1 , 1 2 , ICL ASS) 

C 

300  IF  (NPPS.EQ.O)  GO  TO  400 
ICLASS= 1 04 
C 

CALL  METHA(NPPS,ABPT,I1,I2,ICLASS) 

C 

4 CO  IF  (NICS. EQ. 0)  30  TO  500 
ICLASS=105 
C 

CALL  METhA  (NICS,ABPT, II, 12, IC LASS) 

C 

500  IF  (NSTS.EQ.O)  GO  TO  600 
C 

CALL  METHD  (NSTS, ABPT, 11,12) 

C 

600  IF  (NXS. EQ. 0)  GO  TO  70C 
ICLASS= 107 
C 

CALL  METHA (N XS , ABPT , 1 1 ,12 , ICLA SS) 


A.  BPTROOO 
ABPTROC  1 
ABPTP002 
ABPTROO 3 
ABPTR004 
A6PTB005 
ABPTR006 
ABPT<'097 
A6PTR908 
ABPTRO09 
ABPTR010 
ABPTR01 1 
ABPTR012 
ABPTR01 3 
ABPTRO  14 
ABPTR01 5 
ABPTR916 
A3FTR017 
ABPTRO  18 
ABPTF019 
ABPTPC20 
A BPTRO  2 1 
ABPTR022 
ABPTRO  2 3 
ABPTR024 
A6PTR025 
AEPTR026 
ABPTR027 
A8FTR029 
ABPTP029 
ABPTR030 
ABPTRO  3 1 
ABPTR032 
ABPTR033 
ABPTRO  34 
ABPTRO 35 
ABPTR036 
ABPT  R 0 37 
A BPTRO 38 
ABPTR039 
ABPTR040 
ABPTP041 
ABPTP042 
ABPTRC43 
ABPTR044 
ABPTP045 
ABPTR046 
ABPTR047 
ABPTR048 
ABPTR049 
ABPTR050 
ABPTR05  1 
ABPTR052 
ABPTR05  3 
ABPTR054 
ABPTP055 
ABPTR056 
ABPTR057 
A B PTR  05  0 
ABPTR059 
ABPTF060 
ABPTROb 1 
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ABPTR06 

ABPTR06 

ABPTR064 
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SUBROUTINE  ACSRCE 


Purpose: 

To  set  up  the  aircraft  source  arrays  to  be  used  by  the  dispersion 
routines  for  calculating  ground  level  concentrations. 


Input: 

Basic  aircraft  data,  airbase  activity  data,  points  in  arrival- 
departure  paths  and  in  training  flight  paths,  meteorological 
conditions,  time  period  of  calculation. 


Output : 


The  arrays  ACPT,  ACLN  and  ACAR  to  contain  all  source  informa- 
tion necessary  to  calculate  dispersion  and  pollutant  concentra- 
tions. 


Subroutine 

Called: 

DEPART 


24 


SUBROUTINE  ACSRCE  (Cont'd.) 


26 


ANY 

AIRCRAFT 
DEPARTING 
\ / 


BEGIN  LOOP  OVER  K TAXIWAY  SEGMENTS 
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non  non  ooonn  nnnnn 


SUBROUTINE  ACSFCE 


IP! 


-;'L  r'-Klm 


X 


THIS  ROUTINE  SEIS  OP  THE  AIRCRAFT  SOURCE  ARRAYS 
AMO  ALLOCATES  THE  POLLUTANT  EMISSIONS  TO  THE 
APPROPRIATE  AREA  OR  LINE 

REAL  LNDSPD 
INTFGER  ENGNO 

COMMON  /RECPT/  HRECPT , MAX FIL 

COMMON  /SRC E/  N PLTS , NENPT , NENAR, NENLN , N ABPT , N ABAR , N AB LN , NACPT, 

. NACAP, MACLN, ENPT ( 16 , 100)  f ENAR (1 1 , 100)  , ENLN (14,20) , ABPT  ( 1 6 , 1 50)  , 

. ABAF  (11, 100) , ABLN (14,100) ,ACPT(16,1)  ,ACAR(11,24)  , ACLN ( 1 8 , 25 0) 
COMMON  /ACEDB1/  ACEMFC  (8 , 1 0, 6)  , ASCNT1  (8) , ASCNT2  (8 ) ,T XIS PD (8)  , 

. LNDSPD (8) , APSPD1 (8) , AFSPD2(8) ,COHT1 (8) ,TOSPD(8) ,COSPD1  (6) , 

. COSPD2  (8) , SRTUPT ( 8)  ,DSCNT1(8)  , EGCHKT (8) , SHTDNT (8) ,DSCNT2(8)  , 

. APPHT,APPHT2  (8) ,CLMB PT.TOWT (8) , ENGNO (8,2) 

COMMON  /ACEDB2/  N ACT Y P ,NR NVYS , NPK AR, IEG FLG, I ACTYP ( 8)  , AN N ARR ( 8) , 

. ANNDEP  (8) , ANNTGO (8) , ARRFCN ( 24 , 8 , 6)  , DE PFC N (24 , 8 , 6) ,TGO  (3,4,8) , 

. DISRNH  (6)  , RNWY  (7,6)  . IUSHD(20,6)  , ACFUEL  (8)  , ARFLVT  ( 8)  ,DPFLVT(8)  , 

. ACSPIL (8) , ARSVEM (6,8,5) , DPS VE M (6 , 8, 5)  ,NIBTT(6)  ,NIBSEG(8,6) , 

. IIBSEG(16,8,6)  , IDIBTW  (8, 6) , TT ARF R (8 , 8 , 6) ,NOBTT(6) ,NOBSEG(8,6)  , 

. IOBSEG  (16,8,6)  ,IOBTV  (8,6)  , TT  DPFR  (8 , 8 , 6)  ,NPASQ(6)  ,IDPR«(A(6)  , 

. PAREA(6,3,3)  , I DIBP A (8,6)  ,IDOBPA(8,6)  , NLSEGS , ACLNSG  (1 2 , 25)  , J ES 1 (8 ) 
COMMON  / MET  / WS, WSM PH, IHS , HD, IHD, SI NEWD, COSEHD,  JSTAB, HLID , TEMF, 

1 TEHK 

COMMON  / DEFALT  / IT  APE, ACLNDY , AC LNDZ, AL PH  A (7 ) , BET  A (7 ) , FLDE NS ( 7) 
COMMON  /DSTRET/  ACMO  ( 1 3, 8 ) , ACDY (2 , 8) , ACHR (24, 8)  , V HMLMO  ( 1 3)  , 

. VHMLDY (2) , VHMLHR (24)  ,CVABMO(13)  , C VABD Y (2) , C V ABHR (24)  ,CVENMO(13) , 

. CVENDY (2)  ,CVENHR (24)  ,FLMO(13,7)  , FLDY  (2, 7) , FLHR  (24 , 7 ) ,NC1 
COMMON  /PERIOD/  IMO  , NODAYS, IDY  , IH R 1 , I HR2, IFL AG, JFL AG 
DIMENSION  I ACAR  (2, 18)  ,FRAC(8)  ,PARFCT(18) ,APARSQ(6,3) , NQ(25) 

XF  ( XO , YC , V) =YC*SIN (V)  +XO 
YP(YO,YC,H) = YC  *COS (H)  +YO 
DAY  S=NODAYS 
NT=NFLTS»5 
IWIND=29+IWD 

AN  I FI AG  OF  0 MEANS  THAT  ALL  AIRCRAFT  SOURCES  EXCEPT 
FOR  RUNWAY  ROLL  AND  CLINBOUT  MODES  1 AND  2 REMAIN 
UNCHANGED 

IF  (IFLAG.EQ.O)  GO  TO  69 

READ  ARRFCN  AND  DEPFCN  FROM  TAPE 

IF  (IWD.GE. 1. AND. IHD. LE. MAXFIL)  GOTO  1000 
PRINT  9000, HRECPT, MAXFIL, IHD 
9000  FORMAT  (29HCFILE  REQUEST  ERROR  IN  ACS RCE, 315) 

GO  TO  1040 

1000  IF  (NRECPT-IWD)  1010,1030,1020 
1010  READ  (30) 

HFECFT=HRECPT+1 
GC  TO  1000 
1020  REWIND  30 
MRECFT=1 
GC  TC  1000 

1030  READ  (30)  ARRFCN, DEPFCN 
HRECPT=HRECPT*1 
1040  CONTINUE 


ACS  RC000 
ACSRC09  1 
ACSRC002 
ACSRCOO  3 
ACSRC004 
ACSPC005 
ACSRC006 
ACSRC007 
ACSPCC08 
ACSRC009 
ACSPC010 
ACSRC01  1 
ACSRCO 1 2 
ACSRC013 
ACSRCO 14 
ACSRCO 1 5 
ACSRC016 
ACSRCO  17 
ACSRC018 
ACSPC01 9 
ACSRC020 
ACSRC02 1 
ACSRC022 
ACSRC023 
ACSRC024 
ACSPC025 
ACSPC026 
ACSRCC27 
ACSRC028 
AC  SRC 02 9 
ACSRC030 
ACSRC03 1 
ACSRC032 
ACSPC033 
ACSFC034 
ACSRC035 
ACSRC036 
ACSPC037 
ACSRC038 
ACSRC039 
ACSRC040 
ACS  RCO  4 1 
ACSPC042 
ACSPC043 
ACS  RCO  4 4 
ACSRC045 
ACSPC046 
A C SEC  04  7 
ACSRC048 
ACSRC049 
ACSRC050 
ACSPC051 
ACSPC052 
ACSRC053 
ACSPC054 
ACSPC555 
ACSPC056 
ACSPC057 
ACSRC058 


FOR  EACH  AIRCRAFT  TYPE  COMPUTE  FRAC  USING  TEMPORAL 
DISTRIBUTION  ARRAYS  FOR  AIRCRAFT  ACTIVITY 


ACS  PCO  59 
ACSPC060 

AC?prof>  i 


30 


on  ooonnn  o non 


■ 


T 


N HI  = I HR2 

IF(IHR1.GT. I HP  2)  NHI=24+IHR2 

HRS=NHI-IHR1+1 

DC  5 1=1, NACTYP 

HRFRC=0. 

DC  4 J J = I HR  1 , KHI 
J=JJ 

IF  (J J . GX. 24)  J = JJ- 24 

4 HRFRC=HFFPC  + ACHP  (J,I) 

HRFPC=HRFRC/HFS 

FRAC  (I) = ACMO  (I  MO, I)  *A  CEY (IDY,  I) * HRF RC*7 . 0/D AYS* (1 . E+6/3.6) 

5 CONTINUE 
8 N ACPI  = C 

NB  = C 
NC  = 0 
N2  = 0 

SET  UE  SQUARE  AREA  SOURCES  DUE  TO  AIRCRAFT  PARKING  AREAS 

DO  1 L=1 , NPKAR 

NSQ=NFASQ  (L) 

SEAFSQ=0. 0 
DO  2 J= 1 , NS Q 
NE=N  E+ 1 

ACA  P (1 , NB) = PARE A (L  , J,  1) 

ACAF ( 2 , NB)  = PAFEA(L,J, 2) 

ACAR  (3,NB)  = ACLNDZ/2. 

ACAR  ( 4 , N B)  = PAFEA(L,J,  3)  *1000. 

AEAFSQ(L,J) = ACAR(4,NB)  **  2 
SPAFSQ  = SPARSQ  ♦ APARSQ(L,J) 

ACAR (5, NB) = ACLNDZ 
I AC  A F (1 , NE) =1 DPRKA  (L) 

2 IACAP  (2, NB)  =NSQ 
DO  91  J= 1 , N SQ 
NZ=  NZ ♦ 1 

91  FAFFCT(NZ)  = APAPSQ(L,J)  / SPARSQ 
1 CONTINUE 

DO  93  1=1, NLSF5S 
93  NQ  (I ) =0 
NFKSRC=NB 
DC  3 L= 1 , NPKSRC 
DC  3 K=6 , NT 

HRACAR  (K-5, L) =0.0 

3 ACAR  (K,L) =0.0 

TVP=  EXP (ALPHA (2) -BETA  (2) /TENK) 

BEGIN  IOOP  OYER  N RUNWAYS 
DC  10  N=1,NENVYS 

IS  RUNWAY  USED  WITH  THIS  WIND  DIRECTION? 

IF  (1USWD (I  WE, N) .EQ.O)  GO  TO  10 
THETA=  RNWY  (7, N) 

XC  = 0.25*DISRNV (N)*SIN  (THETA) ♦ R NWY  (2,N) 

YC=0.25*DISPNW(N)  *COS  (THETA)  +RNWY  (3,  N) 

NTT  = N IBTT  (N) 

IF (NTT. EQ.O)  GO  TO  SO 

BEGIN  LOOP  OVER  J INBOUND  TAXIWAYS 


ACSRC062 
ACSRC06  3 
ACSPC064 
ACSPC065 
ACSRC066 
ACSPC067 
ACSPC068 
AC  SRC  06 9 
ACSRC070 
ACSRC07 1 
ACSPC0?2 
ACSRC07  3 
ACSRC074 
ACSPC075 
ACSRC076 
ACSRC077 
ACSRC078 
ACSRC079 
ACSRC080 
ACSPC08 1 
ACSPC082 
AC  SRC  08  3 
ACSRC084 
ACSRC085 
ACSPC086 
AC  S RC  087 
ACSFC088 
ACSPC089 
ACSRC090 
ACSRC091 
ACSRC092 
ACSRC093 
ACSRC094 
ACSPC095 
ACSPC096 
ACSPC097 
ACSRC098 
ACSPC099 
ACSRC100 
ACSPC10 1 
ACS  RC  10  2 
ACSRC103 
ACSPC104 
ACSRC10S 
ACSPC106 
AC  SRC  107 
ACSRC1 08 
ACSPC  109 
ACSRC110 
ACSRC1 1 1 
ACSPC112 
ACSRC113 
ACSRC114 
AC  SRC  1 1 5 
ACS  RC  1 1 6 
ACSRC1  17 
ACSRC1 1 8 
ACSRC119 
ACSPC120 
ACS  PCI  2 1 
AC  SRC  1 22 
ACSRC1 23 


3 


I 


nono  nnonnn  non 


DC  11  J= 1 , NTT 

ANY  AIRCRAFT  ARRIVING  ON  THIS  RUNWAY? 

DC  7 1 = 1 , NACTYP 

IF (TTARFR ( J , I , N) *ARRFCN(23,I, N) . GT.0.0)  GO  TO  701 
7 CONTINUE 
GC  TC  11 

701  NSGLNS  = NIBSEG  (J , N) 

BEGIN  LOOP  OVER  K TAXIWAY  SEGHENTS 
DC  12  K=1, NSGLNS 

SET  UE  SEGMENT  LINE  SOURCE  GEOMETRIES 

JJ  = IIBSEG  (K,  J,  N) 

IF  (NQ  (JJ)  .NE.O)  GO  TO  130 
NC=NC+ 1 
NQ(JJ)=NC 
DO  121  L=1,  12 

121  ACLN(L,NC)=ACLNSG(L,JJ) 

ACL N (9, NC) =1.0 
ACLN  (10, NC) =1.0 

ALLOCATE  AIRCFAFT  INBOUND  TAXIING  POLLUTANT  EMISSIONS 
TO  APPROPRIATE  SEGMENTS 

DO  13  L=1  , N PLTS 
LL=L+12 

13  ACLN  (LL,NC)  =0.0 
130  ND=NC(JJ) 

DC  14  1=1, NACTYP 
AA=ENGNO  (I  ,1) 

IF  (IEGFLG.GT.O)  AA  = EN GNO ( I ,2) 

ARR  = TTARFR  (J,I,N) * ARR FCN ( 23, 1 , N) *ANNARR (I) 

IF  (ARR.LE.0.0) GO  TO  14 

TIME  = ACLN(1 1,ND)/(TXISFD(I  ) * ACLNSG (9 , J J) ) 
FRC=AA*ARR*TIME*FRAC (I  ) 

DC  15  L=1 , NPLTS 
KK=  L* 1 2 

15  ACLN (KK,ND) = ACLN (KK , N D) +FRC* ACEMFC (I  ,2,L) 

14  CCNTINUE 
12  CONTINUE 

: END  TAXIWAY  SEGMENT  LOOP 


DETERMINE  AIRCRAFT  INBOUND  PARKING  AREA 
ASSOCIATED  WITH  TAXIWAY  PATH 

DO  16  1= 1 , N PKSRC 
II  = I 

ICPK  = I ACA  R ( 1 , J) 

IF(TDPK.EQ.IDIBPA(J,N))GO  TO  17 
CONTINUE 

PRINT  18,  IDIEPA (J,N)  ,J,N 

FORMAT  ( • 01 NBCU ND  PAPKING  AREA  *13, 'OF  TAXI W AY= • 1 3, • ; RUNWAY 
1 IS  NOT  CONSISTANT  WITH  PARKING  AREA  ID  NUMBERS*) 

STOP 

CONTINUE 


ACS  P C 1 24 
AC  SRC  1 2 5 
ACS  PC  126 
AC  SRC  1 27 
ACSPC128 
ACS  PC  12° 
ACSPC 1 10 
ACS  °C  1 '*  1 
ACSPC1 32 
ACS  PC  1 3 3 
ACSRC13U 
ACSPC135 
ACSRC1  36 
ACSPC 1 37 
ACSRC1 38 
ACSPC  139 
ACSFC1U0 
ACSRC14 1 
ACSPC142 
ACSPC  14  3 
A.CSPC144 
ACS  RC 1 4 5 
ACSRC146 
AC?  RC  1 47 
ACSPC1  48 
ACS  RC 1 49 
AC  SRC  150 
AC  S PC  1 5 1 
ACS  PC  1 5 2 
AC  S PC  1 5 3 
ACSPC  154 
ACSPC  15  5 
ACCPC156 
ACS  FC  15  7 
ACSPC158 
ACS  FC 1 ? 9 
ACSPC  160 
ACSPC  16  1 
ACSFC162 
ACSRC  163 
ACS  PC  16  4 
ACSPC165 
ACSPC166 
ACSRC  1 6 “* 
AC  SRC  1 6 8 
ACS  R C 16  9 
AC  SRC  1 s 0 
ACS«C171 
ACSPC  17  2 
AC  SRC  1 7 3 
ACS  PC  1 74 
ACSRC  1 76 
ACS  RC  1 76 
AC  SRC  177 
ACS  PC  1 78 
AC5PC179 
AC  c sc  1 8 0 
ACSPC  131 
= 'I3, * ACSRC  19 2 
ACSPC1 93 
AC  ? PC  1 3 4 
AC5P-:195 
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20 
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C 

c 

c 
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A l L CO 7 E ALl  AIRCRAFT  IDLE  AT  SHUTDOWN,  REFUELING, 

AFP1VAL  FUEL  VENTING  AND  SERVICE  VEHICLE  EMISSIONS 
TC  APFROPPI ATE  AREA 

NSQ=I ACAP <2, II) 

DC  19  1=1, N ACT YP 

APF  = TTAPFP (J, I,N) *ARRFCN (2  3, I, N)  *ANNARR  (I) 

IF (APR. LE. 0.0)  GO  TO  19 
AA=FNGNO (1,1) 

IF (IEGFLG.GI.O)  AA  = EN GNO  ( 1 ,2) 

TI HE=  SHTDNT (I) /60. 

FFC=AA*ARR*TIME*FRAC(I) 

TVP  = EXF (ALPHA (JES1  (I)  ) - BETA  ( JES1 (I) ) / TEMK) 

DC  20  L=1 , NSQ 
J J=I I *L- 1 
DO  21  K= 1 , N PLTS 
KK=K*5 

ACAP  (KK,JJ) = ACAR(KK,JJ) ♦ FRC* ACEMFC ( I , 1 , K)  * PARFCT(JJ) 

ACAR  (KF , J J) =ACAR(KK,JJ)  ♦ (AFSVEM (K,  I,  1)  ♦ ARS  VEM  (K  , I , 2)  + 

. APSVFM (K,I,3)  ♦ ARSVEH  (K,I ,4) ♦ ARS VEM (K , I , 5) ) * ARR  * FRAC(I) 

. * PARFCT(JJ) 

IF (K. EQ. 2)  ACAR  (KK, JJ) =ACAR(KK,JJ)  + (0 . 3*TVP*ACFUEL (I) *0.5 
1/10C0.  ♦ ACSPIL (I)  + ARFLVT(I))  * ARR  * FLDENS  (JES 1 (I) ) * FRAC(I) 

. * FARFCT(JJ) 

CONTINUE 

CONTINUE 

CONTINUE 

CONTINUE 

END  INEOUND  TAXIWAY  LOOP 


BEGIN  LOOP  OVER  I AIRCRAFT  USED 
DC  30  1 = 1 , N ACTYP 

CALCULATE  RUNWAY  ARRIVALS  FOR  EACH  AIRCRAFT  TYPE 
A R R=  AF  PFCN  (23,I,N)*ANNARP(I) 

ANY  AIPCPAFT  ARRIVING? 

IF  (AFP. LE. 0.0)  GO  TO  30 

SET  UP  LINE  SOURCES  FOR  APPROACH  AND  LANDING  MODES  7,  8 AND  9 
AND  ALLOCATE  POLLUTANT  EMISSIONS 

A A = ENG  NC  ( 1 , 1) 

DC  31  J = 1 , 3 
DO  32  Ml,  3 
KK=K+NC 
JK=6*F-6+J 

ACLN  (J,KK) = APPFCN  (JK,  I , N) 

ACLN  (J«5,KK) =ARRFCN (JK*6,I,N) 

CONTINUE 
JJ=NC*J 
JK=6* J-2 

ACLN  (4,JJ)  = ARRFCN(2«,I,N) 

ACLN  (5, JJ) = DEPFCN (24, I , N) 

ACLN  (09, JJ) =AFRFCN  (JK,I,N) 

ACLN  (10, JJ) =ARFFCN (JK*6,I ,N) 


ACS  PCI  86 
ACS  PC  1 97 
AC  S RC 19  8 
ACSRC1 8 9 
AC  SRC  190 
ACSRC19 1 
ACS  RC 19  2 
AC  SRC  1 9 3 
ACS  PC  1 9 4 
ACSRC195 
ACS  RC 1 96 
ACS  PC  197 
ACSRC198 

ACS  RC 1 99 

ACSPC200 
ACS  RC  20  1 
ACSRC202 
ACSRC203 
ACSRC204 
AC  SRC  20  5 
ACSRC206 
ACSPC207 
ACSRC208 
ACS  RC209 
ACSRC21 0 
ACSPC21 1 
ACSRC21 2 
ACSRC213 
AC  SRC  2 1 4 
ACSRC215 
ACSRC2  1 6 
ACSPC217 
ACS  RC  2 1 8 
ACSPC219 
ACSRC220 
ACSRC221 
ACSRC222 
ACSPC223 
ACSRC224 
AC  S RC  22  5 
ACSPC226 
ACSPC227 
AC  SRC  22  8 
ACS  PC229 
ACSRC230 
ACSPC231 
ACS  PC  2 32 
ACSPC23  3 
ACSRC234 
ACSRC235 
ACS  RC  236 
ACSPC237 
ACSRC238 
ACSRC239 
ACSPC240 
ACSPC24 1 
ACSPC242 
ACS  PC  24  3 
ACSRC244 
ACSPC245 
ACSPC246 
ACSPC247 
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ACLN  (11, JJ) =ARRFCN (JK*1,I,N) 

ACSPC248 

ACLN  (12, JJ) = AF  RFCN  (JK*2,I,N) 

AC  SRC  24  9 

JHODE=J*6 

ACS  PC250 

DO  33  K=  1 , N FLTS 

ACS  PC  251 

KK=r*12 

ACSFC252 

ACLN  (KK.JJ)  = AA*  ACEH  FC  (I.JHODE, K)  *ARR* ARRFCN  (JK  ♦ 2 , 1 , N ) * FR  AC  ( I) 

ACSPC253 

CONTINUE 

ACSRC254 

CONTINUE 

ACSPC255 

NC=NC*3 

ACSRC256 

ACSPC257 

SET 

UF  LINE  SOURCES  FCR  TRAINING  FLIGHT  OPERATIONS 

ACSRC258 

AND 

ALLOCATE  FOLLUTANT  EHISSIONS 

ACS  PC259 

AC  S RC  26  0 

IF  (ANNTGO(I)  . LE  . 0 . 0)  GO  TO  30 

ACS  PC  26 1 

NC=  NC*  1 

ACSRC26  2 

ACLN 

(1,NC)=XP(XO,TGO (1,1,1) .THETA) 

ACSPC26  3 

ACLN 

(2,NC)=YP(YO,TGO(1,1,I) .THETA) 

ACS  PC  26  4 

ACLN 

(6,NC)=XP(XO,TGO(1,2,I) .THETA) 

ACSPC26  5 

ACLN 

(7, NC) = YP  (YO.TGO ( 1 , 2, I) .THETA) 

ACSPC266 

ACLN 

(1,NC*1)=ACLN(6,NC) 

ACSPC267 

ACLN 

(2,NC*1) = ACLN ( 7 , NC) 

ACS  RC  26  8 

ACLN 

(6  , NC*1 ) =XO 

ACSFC269 

ACLN 

(7,NC*1) = YO 

ACSRC270 

ACLN 

(1 , NC  + 2) =XO 

ACSFC271 

ACLN 

(2,NC*2) =Y  0 

ACS  PC  27  2 

ACLN 

(6,NC*2)=XP(XO,0.  304  8, THETA) 

ACSPC273 

ACLN 

(7, NC+2)  =YP (YO.O.  304  8, THETA) 

ACSRC274 

ACLN 

(1,NC+3)=ACLN(6,NC*2) 

ACSRC275 

ACLN 

( 2, NC  + 3) = ACLN ( 7 , NC*2) 

ACS  PC  276 

ACLN 

(6,NC  + 3) =XP  (XO.TGC  (1,3,1)  .THETA) 

AC  SRC  277 

ACLN 

(7,NC*3)=YP(YO,TGO(1,3,I)  .THETA) 

ACSRC278 

ACLN 

(1,NC+4)=ACLN(6,NC*3) 

AC  SRC  2^9 

ACLN 

(2.NC  + 4) =ACLN ( 7 , N C*  3) 

ACS  RC  280 

ACLN 

<6,NC+4)=XP(XO,TGO  (1,4,1)  .THETA) 

ACSRC28 1 

ACLN 

(7 , NC  +4) = YP  (YO.TGO (1,4,1)  .THETA) 

ACSFC282 

ACLN 

(3,NC)=APFHT*1000. 

ACSPC283 

ACLN 

<8,NC)=APPHT2(I)*1000. 

ACSPC284 

ACLN 

(3,NC+1)=APPHT2(I) *1000. 

ACSRC285 

ACLN 

(8,NC*1)=ACLNDZ/2. 

ACS  RC286 

ACLN 

(3, NC*2) =ACLNCZ/2. 

ACS  PC  287 

ACLN 

(6,NC*2)=ACLNDZ/2. 

ACSFC288 

ACLN 

(3, NC  + 3) = ACLNDZ/2 . 

ACSRC299 

ACLN 

(8 , NC*  3) =COHT 1 (I) *1000. 

ACSPC290 

ACLN 

( 3, NC  +4 ) =COHT1  (I) *1000. 

ACSPC29 1 

ACLN 

(8 , NC+4 ) =CLHBHT* 1 000 . 

ACSFC292 

ACLN 

(09, NC)  = APS  PD1  (I) 

AC  SPC  2°  3 

ACLN 

(10, NC) = APSPD2  (I) 

ACS  PC  29  4 

ACLN 

(1 1 , NC) =TGO  (2, 1 , 1 ) 

ACSRC295 

ACLN 

(12, NC)  = TGO (3, 1,1) 

ACS  RC296 

ACLN 

(09,NC*1)  = APSPD2  (I) 

AC  S RC  297 

ACLN 

(10,NC*1) =LNDSPD  ( I) 

ACS  RC  29  8 

ACLN 

(1 1 , NC* 1) =TGO (2,2,1) 

ACSRC299 

ACLN 

(12,NC*1)=TGO(3,2,I) 

ACSRC300 

ACLN 

(09, NC+2) =LNDSPD ( I) * 1 . 3 

ACSPC301 

ACLN 

(10,NC*2)=TOSPD(I)*0.7 

AC  SRC  30  2 

ACLN 

(11, NC*  2) =0 . 3048 

ACSPC30  3 

ACLN 

(12, NC*2) =2.0*0.3048/(1.  3*LNDSPD (I) *0 . 7 *TOSPD ( I)  ) 

AC  S RC  304 

ACLN 

(09, NC*3) =TOSPD (I) 

ACS  PC  30  5 

ACLN 

(10,NC*3)=COSPD1 (I) 

AC  ^PC  30  6 

ACLN 

(11,NC*3)=TGO(2,3,I) 

ACSRC397 

ACLN 

(12,NC*3)=TGO(3,3,I) 

ACSPC308 

ACLN 

(09,NC*4)=COSPD1(I) 

ACS  RC  30  9 

34 
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ACLN  (10,  NO  4)  =C0S  PD2  ( I) 

ACLN (1 1 , NC+4) =TG0  (2,4,1) 

ACLN  (12,NC  + 4) = TG0 (3,4,1) 

DO  45  J=1,5 
JJ=NC+J-1 

ACLN (4, JJ) = ARPFCN (24, I, N) 

ACLN (5, JJ) =DEPFCN (24,  I,N) 

GO  TO  (34,35,41,36,37)  ,J 

34  KD  = 7 

GC  10  38 

35  KD  = 8 

GO  TC  38 

36  KD=5 

GO  TO  38 

37  KD=6 

38  DO  39  K=  1 , N PLTS 
KK=K+ 1 2 

39  ACLN (KK, JJ) =ANNTGO (I) * ACEH FC ( I , KD , K) *A F RFCN  (23 , 1 , N)  *ACLN(12,JJ)  * 
1 FP AC  (X) *A A 

GO  TO  45 

41  DO  42  K= 1 , NPLTS 
KK=  K+ 1 2 

42  ACLN (KK, JJ)  =AA* (0. 3*ACEHFC  (I, 9, K) +0 . 7* ACEHFC (I ,4 , K) ) * 

1 ANNTGC (I) * ARPFCN (23, I , N) *ACLN(12,JJ) *FRAC(I) 

45  CONTINUE 
NC=NC+4 
30  CONTINUE 

END  AIRCRAFT  LOOP 

50  NTT=N0BTT  (N) 

IF(NTT.EQ.O)  GO  TO  10 

BEGIN  LOOP  OVER  J OUTBOUND  TAXIWAYS 

DC  51  J= 1 , NTT 

ANY  AI PCP  AFT  DEPARTING  ON  THIS  TAXIWAY? 

DC  6 1 = 1, NACTY P 

IF (TTDPFP ( J , I , N ) *DEPECN  (23,1, N) .GT.O. 0)  GO  TO  601 
6 CONTINUE 
GC  TC  51 

601  NSGLNS=NOBSEG(J,N) 

BEGIN  LOOP  OVER  K TAXIWAY  SEGHENTS 
DC  52  K= 1 , N SGL N S 

SET  IJP  SEGHENT  LINE  SOURCE  GEOHETRIES 

JJ=IOESEG(K,J,N) 

IF  ( NC  (JJ)  .NE.O)  GO  TO  131 

NC=NC+1 

NQ(JJ) =NC 

DC  122  L= 1 , 1 2 

122  ACLN(L,NC)=ACLNSG(L,JJ) 

ACLN  (9, NC)  = 1.0 
ACLN (10, NC)  =1.0 

ALLOCATE  AIRCFAFT  INBOUND  TAXIING  POLLUTANT  EHISSIONS 
TC  AFFRCPPI ATE  SEGHENTS 


ACS  PC  3 10 
ACSRC311 
ACS  RC  3 1 2 
ACSRC31 3 
ACS  PC  3 1 4 
ACSPC315 
ACS  RC  31 6 
ACSRC317 
ACSRC31 8 
ACSRC319 
ACSRC320 
ACSBC32 1 
ACSRC322 
ACS  PC  323 
ACSRC324 
ACSPC325 
ACSRC326 
ACS  RC  327 
ACSPC328 
AC  SRC  32  9 
ACS  RC  3 30 
ACSRC331 
ACS  RC  3 32 
ACS  RC  3 3 3 
ACSRC334 
ACSBC335 
ACPPC336 
ACS  PC  3 37 
ACSPC338 
ACS  PC  339 
AC  SRC  34  0 
ACS  PC  34  1 
ACS PC  34 2 
ACSPC34 3 
ACS  RC  34  4 
ACSRC345 
ACSPC346 
ACSPC347 
ACS  RC  34  8 
ACS  RC  34  9 
ACSPC350 
ACS  RC  35  1 
ACSRC352 
ACSPC353 
AC  S RC  354 
ACS  PC  355 
ACSRC356 
ACS  PC  357 
AC  SRC  358 
ACS  RC  359 
AC  SRC  360 
ACS  RC  36 1 
ACS  RC  362 
ACSRC363 
ACSRC364 
AC  SRC  365 
ACS  PC  366 
ACSRC367 
ACSPC368 
AC  SRC  369 
ACSRC370 
ACSRC37 1 
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DC  53  L=  1 , NPLTS 
LL=  L* 1 2 

53  ACLN(LL,NC) =0.0 
131  ND=NC(JJ) 

DC  54  1 = 1 , N ACTYP 

DEP=TTDPFR (J,I,N) *DEPFCN (23, I , N) • ANN DEP  (I) 
IF (DEP.LE.0.0)  GO  TO  54 
AA=ENGNO  (I,  1) 

IF  (IEGFIG.GT.0)  A A= ENGHO ( 1 , 2) 

TIME=  ACLN  ( 1 1 , N D)  / TXISPD(I) 

F RC  = AA*  DEP*TIME*FRAC  (I) 

DO  55  1=1, NPLTS 
KK=  L* 1 2 

ACLN(KK.ND) = ACLN(KK.NC)  ♦ F RC* ACEHFC ( I , 2, L) 
CONTINUE 
CONTINUE 


55 

54 

52 


C 

C 

c 

c 

c 

c 

c 


END  1 A XI HAY  SFGMENT  LOOP 


DETERMINE  AIRCRAFT  OUTBOUND  PARKING  AREA  ASSOCIATED 
WITH  TAXIWAY  PATH 

DO  56  1=  1 , N PK  SRC 
II  =1 

IDPK=IACAR(1, I) 

IF(IDFK.EQ. IDOPPA(J.N))  GOTO  58 
56  CONTINUE 

PRINT  57 , TDOBP A (J , N)  ,J,N 

57  FORMAT  (22H0 CUTBOUN D PARKING  APEA,I3,11H  OF  TAXIW AY , 13 , 9H , RUNWAY, 
. 1 3 , 4 7H  IS  NOT  CONSISTENT  WITH  PARKING  AREA  ID  NUMBERS) 

STOP 

ALLOCATE  ALL  AIRCRAFT  IDLE  AT  STARTUP,  DEPARTURE  FUEL 
VENTING  AND  SERVICE  VEHICLE  EMISSIONS  TO  APPROPRIATE  AREA 

58  NSQ=IACAR <2,11  ) 

DO  59  1= 1 , N ACT YP 

DEP=TTDPFR (J,I ,N) * DEP FCN ( 23,  I , N)  * ANNDEP (I) 

IF  (DEP. EQ. 0.0)  GO  TO  59 
AA=ENGNO  (1 , 1) 

IF  (IEGFLG.GT.O)  A A= EN GNO (1 , 2) 

TIME=SRTUPT (I) /60. 

FRC  = AA*  DEP*  TIME  * FRAC(I) 

TVP  = EXF (ALPHA (JESl (I)  ) - BETA ( JES 1 (I)  ) / TEMK) 

DC  60  L = 1 , N SQ 
JJ  =11  *L-1 
DO  61  K=1, NPLTS 
KK=K*5 

ACAR  (KK, J J)  = ACAR(KK.JJ)  ♦ ((FRC  * ACE  MFC ( I , 1 , K)  ) ♦ 

. ( (DFSVEM(K,I, 1)  ♦ DPSVEH (K, 1,2)  ♦ DPSV EM (K , I, 3)  ♦ DP S VEM (K , 1 , 4) 

. ♦ DPS VEM  (K , 1, 5 ) ) * DEP  * FRAC  (I) ) ) * PARFCT(JJ) 

IF  (K.EQ.2)  ACAR  (KK , JO)  = ACAR(KK,JJ) 

. JES 1 (I) ) * FRAC  (I)  * PARFCT ( J J) 

61  CONTINUE 
60  CONTINUE 

59  CONTINUE 
51  CONTINUE 

END  OUTBOUND  TAXIWAY  LOOP 


♦ DPFLVT(I)  * DEP  * FLDENS  ( 


AC  S RC  37  2 
ACS  RC  37  1 
ACSPC 374 
ACS  RC  37  5 
ACSPC376 
ACSPC  377 
AC  SRC  37  P 
AC  S PC  379 
ACSPC  380 
ACSRC3R 1 
ACS  PC  38  2 
AC  S SC  38  3 
ACS  RC  3 8 U 
ACSRC385 
AC  SRC  386 
ACS  RC  307 
ACSPC38R 
ACSRC38R 
AC  S RC  39  0 
ACS  RC  39  1 
ACSPC  39  2 
AC  SRC  39 3 
ACS  PC  3°  4 
ACSRC395 
ACSRC396 
AC  S RC  397 
ACS  PC  39  8 
ACSRC399 
ACSRC400 
ACSRC40 1 
ACSPC402 
ACSRC403 
ACS  RC 40  4 
ACSRC405 
ACS  PC406 
ACSRC407 
ACSRC408 
ACSPC409 
ACSRC410 
AC  SRC  41  1 
ACSPC4 1 2 
ACSPC4 1 3 
AC  S RC  4 1 4 
ACSPC415 
ACSRC4 16 
ACSPC41 7 
ACSRC418 
ACSRC419 
ACSRC420 
AC  S PC  42 1 
ACS  PC  4 22 
ACSPC423 
AC  c PC  4 2 4 
ACS  RC425 
ACSPC426 
ACSFC427 
ACSPC42P 
ACSRC429 
AC  S c C4  30 
ACSRC431 
AC  S °C  4 3 2 
ACS  °C4  ? 3 
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67 

66 

10 


69 


NB=NB-»1 


SET  tJP  ABE  A SOURCE  AT  TAIL  OF  RUNWAY  AND  ALLOCATE 
ENGINE  CHECK  HUSSIONS  TO  IT 

ACAP <1,NB) = PNVY  (2,N) - .05  * SIN  (THETA ) 

ACAP  (2,NB)=RNWY  (3,  N)  - ,05*COS  (THET  A) 

ACAR(3,NB)=  ACLNDZ/2. 

ACAF (4, NB) = 1C0.0 
ACAR  (5 , NB)  = ACLNDZ 
DO  65  K=1,NPLTS 
KK=K+5 

ACAP (KK,NB) =0.0 

DO  66  1= 1 , N ACT Y P 

DEP=DEPFCN ( 23, I , N) * AN NDEP  (I) 

IF (DEF.EQ.0.0)  GO  TO  66 
A A = ENGNO  (I,  1) 

IF(IEGFLG.GT.O)  A A= EN GNO (I , 2) 

TIHE=  EGCHKT  (I) /60. 

FRC=  TIMF  *DEP*AA*FRAC  (I) 

DC  67  K=  1 , N PLTS 
KK=K*5 

ACAF.  (KK,NE)  = ACAB(KK,NB)  ♦ FPC*  ACEHFC  (1 , 3,  K) 

CONTINUE 

CONTINUE 

END  PUNWAY  LOOP 

NACAF=NE 
NCI =NC 
NC=  NC  1 

BEGIN  LOOP  OVER  N RUNWAYS 
DO  79  N= 1 , N RNV YS 

IS  PUNWAY  USED  WITH  THIS  WIND  DIRECTION? 

IF(IUSWD(IWD,N) .SQ.O)  GO  TO  79 
BEGIN  LOOP  OVER  I AIPCRAFT  USED 
DO  70  1=  1 , N ACT YP 

CALCULATE  RUNWAY  DEPARIUPFS  FOR  EACH  AIRCRAFT  TYPE 
DEP=DEPFCN (23, I, N) * A N N DE  P (I) 

ANY  AIRCRAFT  DEPARTING  FROM  THIS  RUNWAY? 

IF  (CEP. EQ. 0.0)  30  TO  70 

CALL  DEPART  TO  CALCULATE  POINTS  IN  TAKEOFF  PATH  ACCORDING 
TC  CUPPENT  METEOROLOGICAL  CONDITIONS 

CALL  DEPART  (N,I) 

A A = ENGNO  (I  ,1) 

SET  UP  LINE  SOURCES  FOR  RUNWAY  ROLL  AND  CLIMBOUT  MODES  1 AND  2 
AND  ALLOCATE  POLLUTANT  EMISSIONS 

DO  71  J=1 , 3 


ACSPC434 
ACS  PC<4  35 
ACSPCU36 
ACSRC437 
ACSRC438 
ACSPC439 
ACSPC440 
ACSPC44  1 
ACSPC442 
ACSPC44  3 
ACSPC444 
ACSPC44  5 
ACS  PC446 
ACSFC447 
ACSPC448 
ACSPC449 
ACSRC450 
ACSPC451 
ACSRC452 
ACSRC453 
ACSPC454 
ACSRC455 
ACS  RC456 
ACSRC457 
ACSRC458 
ACSPC459 
ACS  RC460 
ACSRC46 1 
ACSRC462 
ACSPC46  3 
ACSPC464 
ACSRC465 
ACSRC466 
ACSPC467 
ACSRC468 
ACSPC469 
ACSPCU70 
ACSPC471 
ACSRC472 
ACSPC473 
ACSPC474 
ACSRC4T5 
ACSRC476 
ACSPC4T7 
ACSPC478 
ACSPC479 
ACSPC480 
ACS  PC 49  1 
ACSFCU82 
ACSPC4R3 
ACSRC484 
ACSPC485 
ACSPC486 
ACSFC487 
ACSPC488 
ACS  PC489 
ACSRC490 
ACSPC49 1 
ACSRC492 
ACSRC49  3 
ACSFC494 
ACSRC495 
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1 

DO  72  K»1,3 

ACSRC496 

KMK+NC 

ACSRC497 

n 

JK=6*K-6*J 

ACS*»C49fl 

ACL  N (J,KK) -DEPFCN (JK,I,N) 

ACSPC499 

72 

ACLN (J*5,KK)=DEPFCN(JK*6,I,N) 

ACSRC500 

JJ*NC< J 

ACS  PCSO 1 

JK*6*J-2 

ACSRC502 

ACLN (4,JJ) * ARRFCN  (24, 1, N) 

ACSPC50  3 

ACLN (5, JJ) =DEPFCN (24, I,N) 

ACS»CS04 

ACLN (09, JJ) =DEPFCN  (JK,I,N) 

ACSPC505 

ACLN ( 10, JJ) =DEPFCN (JK+6,I,N) 

ACSRC596 

ACLN  (11, J J) =DEPFCN (JK  + 1,I,N) 

ACSRC507 

ACLN  ( 1 2 , J J)  =DEP FCN  (JK  + 2,I,N) 

ACS4CS08 

JBODE=J*  3 

ACSRC509 

DO  73  K = 1 , N PLTS 

ACSRC510 

KK=K«-12 

ACSRC51 1 

ACLN  (KK,JJ)  =AA*ACEBFC  (I,JHODE,K)  *DiP*DEPPCN  (JK  + 2,I,N)  *FR  AC  (I) 

ACSPCS1 2 

73 

CONTI  NOE 

ACSRCS1 3 

71 

CONTINUE 

ACSRC514 

NC=NC*3 

ACSPC515 

70 

CONTINUE 

ACSRCS16 

C 

ACSRCS17 

C 

END  AIRCRAFT  LOOP 

ACSPC51 9 

c 

ACSPC51 9 

79 

CONTINUE 

ACS  RC520 

C 

ACSRC521 

C 

END  RUNWAY  LOOP 

ACSRC522 

c 

ACSPCS2  3 

NACLN=NC 

Ai~SRC524 

RETURN 

ACSPC525 

END 

ACSPC526 

FUNCTION  AINE 


Purpose: 

1.  To  translate  the  line  and  receptor  coordinates  to  an 
x-axis  along  the  wind  vector,  placing  the  origin  of  the 
line  at  its  low  end. 

2.  To  set  up  the  necessary  parameters  for  the  CAVL  and  QMOD 
routines . 

3.  To  determine  the  concentration  due  to  the  given  line. 

Input : 

The  current  wind  direction  and  speed,  and  the  receptor  and 

line  source  data. 

Output : 

The  concentration  computed  by  the  line  source  diffusion 

model  adjusted  for  wind  speed. 


Subroutines 

Called: 


H1NC11CM  AINE  (V’D) 

THIS  FUNCTION  TRANSLATES  THE  LINE  AND  RECEPTOR  COORDINATES  TO  AN 
X-AXIS  ALONG  THE  HIND  VECTOR,  PLACING  THE  ORIGIN  OF  THE  LINE  AT 
ITS  IOV  END.  THE  VEHICLE  MOVES  FROM  (X1,Y1,Z1)  TO  (X2,Y2,Z2) 

COMMON  /M FT/  VS , WSN PH , I WS , HX ,1  HD , SI NEHD .COSEHD, JST AB, HLID, TE HP, 
. TEMK 

COMMON  /RCPT/  NR ECEP , R ECEP  (2, 3 1 2) 

COMMON  /INFO/  I RECEP, IW NDIR, ITY PE, HTAERO, X 1 , Y 1 , Z 1 , H , DELZ , X2, Y2 , 
. V 1 , V 2, DL , T IME , EM  I S (6)  ,NPOL 

COMMON  /LN/  XVI , YW  1 , Z W 1 , XW  2 , Y W 2,  ZW  2,  SUDOY  , SU  DOZ  , IAD  , TAIL  , A , V 12  , 
. HS2,WSC,RR, SP, XST, YST , ZST , XN D , Y ND , Z ND 
DATA  PI32/4. 7123890/ 

CCNC  = 0. 

IF  LINE  TS  ABOVE  LID,  DO  NOT  CALCULATE  CONC 
IF(ZH1.GE.HLID-.5)  GO  TO  60 

TRANSLATE  LINE  AND  RECEPTOR  TO  AXIS  OF  HAN  DIRECTION 

VA  N = PI 32-VD 
CSAN=COS (WAN) 

SNAN=STN (WAN) 

XW2  = (X2-X 1)  *CSAN+  (Y2-Y 1) *SNAN 
YW2  = (X1-X2)  *SNAN+  (Y2-Y 1) *CSAN 
XR  = RECEP(1,IRECEP)  ♦ 1000. 

Y F = PECEP(2,IRECEP)  * 1000. 

ZST=ZW1 

ZND=ZW2 

IF  (Z 1 . LE. Z2)  GO  TO  5 
X V 2 = - X V 2 
XST=  XV'2 
YV2=-YH2 

Y ST  - Y W 2 
X ND  = 0 . 0 
YND=0 . 0 

X P C P = (XR-X2) *CSAN+ (YR-Y2) *SNAN 

Y PCP=  (X2-XP) * SN  A N + (YR-Y2)  *CSAN 
GO  TO  8 

5 CCNTINUF 
XST=0 . C 

Y ST  = 0 . 0 
XND  = X W 2 
YND=YW2 

XRCP=  (XR-X1)  *CSAN+(YR-Y1)  *SNAN 
YRCP=  (X1-XP)  MSNAN+  (YR-Y1) *CSAN 
8 CONTINUE 
ZPCP  = 2. 

IS  THIS  A UNIFORM  LINE  SOURCE 

80  IF  (IAD.EQ.O)  GO  TO  500 

CORRECT  FOR  TAIL  EFFECTS  IF  ARRIVAL  OR  DEPARTURE 

CSA  = - X 7 2 / DL 
VSC  = 2 * HS  * CSA 
EXT  = TAIL  / DL 
DX  * XW2  * EXT 


AI NE0000 
AINEOOO 1 
AINE0002 
AINEOOO  3 
AINE0004 
AINEOOO  5 
AINE0006 
AINE0007 
AINE0008 
Z2, AINE0009 
AINEOO 1 0 
VS , AI NEO0 1 1 
AINEOO 1 2 
AINEOO 1 3 
AINE0014 
AINE0015 
AINEOO 1 6 
AINE0017 
AINE0018 
AINE001 9 
AINE0020 
AINE002 1 
AINEOO 2 2 
AINE0023 
AINE0024 
AINE0025 
AINE0026 
AINE0027 
AINE0028 
AINE0029 
AINE0030 
AINE003  1 
AINE0032 
AINE003  3 
AINE0034 
AI NE0035 
AINE0036 
AINE0037 
AINE0038 
AINE0039 
AINE0040 
AINE004  1 
AINE004 2 
AINE0043 
AINE0044 
AINE0045 
AINE0046 
AINE0047 
AINE0048 
AINE0049 
AINE0050 
AINE0051 
AINE0052 
AINE0053 
AINE0054 
AINE0055 
AINE0056 
AINE0057 
AINE0058 
AINE0059 
AINE0060 
AINE006 1 
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DY  = 

YW2  * EXT 

XW2  = 

XV2  ♦ DX 

YH2  = 

YW2  ♦ DY 

VS  = 

TAIL  / TIME 

VI  = 

VI  ♦ VS 

W2  = 

V2  + VS 

YY 1 = 

SQR  T ( VS2 

♦ 

W1  * 

(W1  + 

WSC)  ) 

YY2  = 

SQRT ( VS2 

♦ 

Vf  2 * 

(W2  ♦ 

WSC)  ) 

SP  = 

YY2 

ARG  = 

(YY2-4  W2 

•f 

WSC/2 

•)  / 

(YY1  + W1  + 

G =YY2  -YY1  - 

WSC/2.  * 

ALOG 

(ARG) 

RR  = 

A / G 

IF  (Z 

I1.NE.Z2. A 

ND. 

I AD.  EQ.  1) 

GO  TO  500 

XRCP 

= XRCP  ♦ 

DX 

YRCP 

= YRCP  ♦ 

DY 

AINF0062 
AINE006  3 
AINE006U 
AINE0065 
AINE0066 
AINE0067 
AINE0068 
HI NE0069 
AI NE0070 

WSC/2.)  AINF0071 

AI NE0072 
AINE007  3 
AI NE0074 
AINE0075 
AINE0076 
AINE0077 
AINE007 
AINE007 
AI NEOOfl  0 
AINE008  1 
AINE00H2 
AI NE008  3 


CALCULATE  THE  CONCENTRATION  DUE  TO  THIS  LINE 

500  CONC=CAVL  (XRCP, YRCP, ZRCP) 

60  AINE  = CONC  / WS 
RETURN 
END 


- 
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BLOCK  DATA 

INITIALIZE  DATA  IN  COHNON  BLOCKS  FOB  SHORT  TERM  MODEL 

REAL’S  POLNAH 

CCflHCN  /ANNHET/  T JAR , ADD, P, P A, WSBAR, DTBAR 

COMMON  /DEFALT/  IT APE , ACLNDY, ACLNDZ , ALPH A (7)  , BETA  (7 ) , FLDENS ( 7) 
CCHHCN  /DSTBET/  ACHO ( 1 3,8)  , ACDY  (2 f 8) , ACHR  (24 , 6) , VHMLMO  ( 1 3)  , 


BLKDT000 
BLKDTOO 1 
BLKDT002 
BLKDT003 
BLKDT004 
BLKDT005 
BLKDT006 
BLKDT007 
ELKDT008 


VHHLDY(2),YHMLHR(24)  ,C?ABHO(13)  ,CVABDY  (2) , CVABHR  (24)  ,CVENMO(13),  BLKDT009 


. CVENDT(2) , CVENHR (24) ,FLHO(13,7) , FLDY  (2, 7)  , FLHR  (24 , 7) ,NC1  BLKDT010 

CCMHON  /LB/  INI , Y« 1 , Z S 1 , IN  2, YW2, ZW2, SUDOY , SODOZ, I AD, T AIL, B , V 1 2 , VS , BLKDT0 1 1 
. WS2,WSC,RR,SP,AA1,AA2,AA3,AA4,AA5,AA6  BLKDT012 

COMMON  /PERIOD/  IHONTH, NODAYS , IDA Y, IHR 1 , IHR 2, 1 FLAG,  JF LAG, IONCE  BLKDTO 1 3 

COMMON  /SRCE/  NPOL , NE NPT, NENAR , NE NLN, N A BPT, N ABAR , N A BLN , NAC PT , BLKDT014 

. NACAR,NACLN,ENPT(16, 100) ,ENAR(11,100) , ENLN (14,20) , ABPT ( 16 , 1 50) , BLKDTO 15 
. ABAR  (11, 100) ,ABLN (14,100) ,ACPT(16,1)  ,ACAR(11,24) , ACLN ( 1 8, 25 0)  BLKDTO 16 
COMMON  /TITL/  POLNAH ( 6) ,TITLE1 (20) , IPCHOS ( 6),NXPOL,IF  BLKDT017 

COMMON  /NND PRO/  IP  (6)  BLKDT0 1 8 

BLKDTO 1 9 

* *•*»•»•*••*•**••**•*«*• DATA  STATEHENTS***************************BLKDT02C 

BLKDT021 

DATA  *»1,  YW 1 , TAIL  / 0.0,  0.0,  140.  / BLKDT022 

DATA  XP  / 0.2,  0.2,  0.2,  0.3,  0.4,  0.4  / BLKDT023 

DATA  ALPHA/  11.70365,  11.10675,  12.42382,  12.68789,  13.687,  BLKDT024 

. 13.038,  13.024  / BLKDT025 

DATA  BETA  / 2868.54,  3129.5187,  3276.8848,  5108.4194,5329.139,  BLKDT026 

. 4789.301,  4782.209  / BLKDT027 

DATA  FLDENS  / 0.695,  0.773,  0.693,  0.842,  0.824,  0.807,  0.807  / BLKDT028 

DATA  ACLNDY,  ACLNDZ  / 20.0,8.0  / ELKDT029 

DATA  ITAPE,  IONCE  / 21,  0 / BLKDTO  30 

DATA  POLNAH  / 8H  CO  ,8H  HC  ,8H  NOX  , 8H  PT  , BLKDTO 3 1 

. 8H  S02  ,8H  POL 6 / BLKDT032 

DATA  ENPT, ENAR, ENLN, ABPT, ABAR, ABLN, ACPT, ACAR, ACLN  / 12660*0.0  / ELKDT033 


DATA  XW1,  YW 1 , TAIL  / 0.0,  0.0,  140.  / BLKDT022 
DATA  XP  / 0.2,  0.2,  0.2,  0.3,  0.4,  0.4  / BLKDT023 
DATA  ALPHA  / 11.70365,  11.10675,  12.42382,  12.68789,  13.687,  BLKDT024 
. 13.038,  13.024  / BLKDT025 
DATA  BETA  / 2868.54,  3129.5187,  3276.8848,  5108.4194,5329.139,  BLKDT026 
. 4789.301,  4782.209  / BLKDT027 
DATA  FLDENS  / 0.695,  0.773,  0.693,  0.842,  0.824,  0.807,  0.807  / BLKDT028 
DATA  ACLNDY,  ACLNDZ  / 20.0,8.0  / ELKDT029 
DATA  ITAPE,  IONCE  / 21,  0 / BLKDTO  30 
DATA  POLNAM  / 8H  CO  ,8H  HC  ,8H  NOX  , 8H  PT  , BLKDTO 3 1 
. 8H  S02  ,8H  POL 6 / BLKDT032 
DATA  ENPT, ENAR, ENLN, ABPT, ABAR, ABLN, ACPT, ACAR, ACLN  / 12660*0.0  / ELKDT033 
DATA  NENPT, NENAR, NENLN, NAB PT,NABAR,NABLN, NAC PT,NACAR, N ACLN  /9*0 . 0/ELK DTO 34 
END  BLKDT035 
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FUNCTION  CAVL 

i 

I I 

Purpose : 

To  compute  the  coupling  coefficient  at  a receptor  due  to  a line 
source . 

Input : 

Meteorological  conditions:  wind  speed;  stability;  mixing  height; 
critical  distance  for  vertical  mixing;  psuedo  downwind  distances 
for  horizontal  and  vertical  spreads  of  the  line  source. 

Source  parameters:  end  point  coordinates  of  the  line  (X-axis 
has  been  chosen  to  be  along  the  wind  vector) ; LAD  flag  for 
uniform  or  non-uniform  line. 

Receptor  coordinates. 

Output : 

CAVL,  the  coupling  coefficient. 


Procedure : 

1.  Test  whether  the  receptor  is  located  with  respect  to  the 
line  source  such  that  the  concentration  is  negligible. 

2.  If  the  angle  between  the  wind  vector  and  line  is  sufficiently 
small,  and  the  line  is  sufficiently  long,  set  a flag  for  the 
line  to  be  segmented. 

3.  Compute  effective  downwind  distance  and  the  horizontal  and 
vertical  dispersion  coefficients. 

4.  Determine  factor  to  be  used  in  subdividing  the  line. 

5.  Test  whether  the  line  has  a uniform  density.  If  it  is  a 
runway  used  for  aircraft  arrival  or  departure  (non-uniform 
density) , call  subroutine  QMOD. 

6.  Determine  the  proper  expression  to  be  used  and  compute  the 
concentration  due  to  the  line  segment. 

7.  Test  whether  further  segments  need  be  considered.  If  not, 
output  the  concentration  for  the  given  receptor. 


Functions 

Called: 


SIGY,SIGZ,DIFERF 


Subroutine 

Called: 

QMOD 


CALCULATE  DOWNWIND 
DISTANCES  AND  TRAVEL  TIMES 
FOR  PSEUDO  UPWIND  END  OF 
LINE: 

DWDA  = XFAR+SUDOY 
DWDB  = XFAR+SUDOZ 
TFAR  = DWDA/WS36 
TFBR  = DWDB/WS36 


CALL  SIGY  AND  SIGZ  TO 
CALCULATE  UPWIND  END 
DISPERSION  COEFFICIENTS 
SIGF  AND  SIGFZ 


STORE  COORDINATES  OF 
UPWIND  AND  DOWNWIND 
ENDS  OF  LINE  IN  XA.YA.ZA 
AND  XB,YB,ZB 


^ ARE  THE  v 
^ Y AND  Z COORDS.  OF^ 
THE  RECEPTOR  WITHIN  4 
TIMES  THE  DISPERSION 
COEFF.  OF  THE  Y AND  Z 
\ COORDS.  OF  THE^ 
LINE 


/"IS  \ 
THIS  A 
SMALL  ANGLE 
\ CASE  / 


SET  I SAC-1 , REDEFINE 
THE  XI  ,Y1 , AND  Z1 
COORDS.  TO  CORRESPOND 
TO  XI  - MIN(XR.XA)  AND 
SET  (X,Y)  AS  THE  MID- 
POINT OF  THE  LINE 


LINE  MUST  BE  DIVIDED: 
I SUB  = 1 
XRS  = (X2-X1) 

YRS  = CY2-Y1) 

ZRS  = (Z2-Z1) 


ICjl 


1.5-ELEM 


USE  PREVIOUSLY 
COMPUTED  VALUE 
FOR  SIGH 


CALCULATE  TRAVEL  TIME, 
THRH  = DWDY/WS36 
AND  CALL  SIGY  FOR 
DISPERSION  COEFF.  SICH 


CALCULATE  TRAVEL  TIME, 
THRV  » DWDZ/WS36 
AND  CALL  SIGZ  FOR 
DISPERSION  COEFF.  SIGV 


COMPUTE  EXPRESSIONS  TO 
BE  USED  IN  APPROXIMATIONS: 
DENH2 ,DENZ2 ,D 


COMPUTE  ARGUMENTS  OF 
EXPONENTIAL  FUNCTIONS  FOR 
VERTICAL  DISPERSION  USING 
SMALL  ANGLE  APPROXIMATION 
ARGZ1,ARGZ2 


COMPUTE  ARGUMENTS  OF 
ERROR  FUNCTIONS  FOR 
HORIZONTAL  DISPERSION 
AL,BA1,BA2 


ZOMPUTE.  ARGZ1  AND 
\RGZ2  FOR  GENERAL 
EQUATION 


SET  YL  AND  ZL  TO 
WH  END  POINT  OF 
SECMJJT 
T-Ar-1  _ . SuSIGV 

FAC3  wj.fi -hubi 


.ARGZl 


COMPUTE  XS1  AS  THE 
DISTANCE  BETWEEN 
(X,Y,Z)  AND  THE 
ORIGINAI.  STARTING 

point  of  tea:  line 


DENZL  = 0.47*HL1EM 
DENZL2  = DENZL2 


SIN* | AND 


COMPUTE  ARGUMENTS  OF 
EXPONENTIAL  FUNCTIONS  FOR 
VERTICAL  DISPERSION  USING 
SMALL  ANGLE  APPROXIMATION 
ARGZ1.ARGZ2 


CALCULATE  TRAVEL  TIME, 
TL  = XZ/WS36 
AND  CALL  SIGY  FOR 
DISPERSION  COEFF. 


COMPUTE  EXPRESSIONS  TO 
BE  USED  IN  APPROXIMATIONS: 
DENHL2 ,DENO 


COMPUTE  ARGUMENTS  OF 
EXPONENTIAL  FUNCTIONS  FOR 
VERTICAL  DISPERSION  USING 
GENERAL  EQUATION 
ARGZ1 ,ARGZ2 


FACT  = e 


aARGZl 

"ARGZ2 


FACT  = FAC1  + 


FAC2  = e 

, , (DWD-X2) • CFAC3-FAC11 


FAC 2 = FAC2  ♦ CpW^XZV  CFAC3-FAC1) 


FUNCTION  CA  VL  (X  R , Y R , Z R) 

CAVI "000 

c 

CA  VLO0n 1 

c 

THIS  FUNCTION  COMPUTES  THE  POLLUTANT  CONCENTE ATION  DUE  TO  A C»VL0002 

c 

FINITE  LINE  SOUFCE 

CA  VI 00^7 

c 

CA.  VI  0004 

CCHHON  /BET/  VS, WSH PH  , IBS , VD, IWD , SI NFWD,COS END, 

JSTAB, HLTD, TEBF,  CAVL0005 

. TEHK 

CA V10006 

COHHON  /INFO/  IPECEP, IWNDIP, IT Y PE , HTA ERO, X5 , Y5 , 

Z5, W,DELZ,X6, Y6,Z6 ,CAVL0007 

. V1,V2,DL,TIBF,EHIS(6) ,NPOL 

CA.VlOOOR 

CORBON  /LN/  XVI , YW 1 , Z W 1 , XV2, Y V2, ZK2, S UDCY , S U DOZ 

, I AD, TAIL, B, V12, VS,CAVL000  9 

. VS2,WSC,RR,SP,XST,YST,ZST,XND,YND,ZND 

CAVL0010 

CCHRCN  /XTRAN/  XZ  ,WSHD,TY ,TZ 

CAVLO01  1 

DATA  COEF1  /. 39894/, COEF2  /. 31831/ 

CA VI  Do  12 

DATA  CAN/0. 7071/, EMIN/9. 144/ 

CAVL0D1 3 

c 

CAVL0014 

c 

INITIALIZE  COUNTERS,  FLAGS  AND  VARIABLES 

CA VL0015 

c 

C A.  V LO  ° 1 6 

ISUE=0 

CA.V10T17 

NSUB=0 

CAVLODI-q 

I SAC=0 

CAVL0019 

LSAC=0 

CAVLOOio 

CEAR=0. 

CAVL0021 

DViDA  = 0 . 

CA VL 0022 

OTOT=0. 

CAVL0023 

SEGL= 1 . 0 

CA VL0024 

WS36=WS*3600. 

CAVL0025 

HLIDH=HLI D 

CA VL0026 

QL  = 1./DL 

CA VLOC27 

c 

CA  VI 0^20 

c 

INTPODUCE  A GENERAL  S ET  CF  NOTATION  SO  THAT  THE  SAME  CAVL C029 

c 

DISPEFSION  CALCULATION  CAN  EE  USED  FOR  THE  SMALL 

ANGLE  CASE  CA  VLr  0 30 

c 

WHERE  THE  LINE  IS  FUPTHFR  S FGHENTED . X1,Y1,Z1  NOW  REFER  TO  THE  CAVL^OOi 

c 

LOW  END  OF  THE  LINE. 

CAVLC032 

c 

CA VL0033 

X1=XN1 

CA.V10034 

Y 1 = Y W 1 

CA VLC035 

Z1=ZW1 

CA VLD036 

X2=XW2 

CA  V LOO  37 

Y2= YW2 

CAVLOO  38 

Z2=ZW2 

CAVL0038 

X MAX  = AH AX  1 (XI ,X2) 

CA  VL0040 

c 

CAVL0041 

c 

CALCULATE  LENGTH  OF  LINE 

CAVL0042 

c 

CAVLC04  3 

5 DLXY  = (X2-X1) **2  + (Y2-Y 1)  **2 

CA VL0044 

DL1  = SQPT  (DLXY) 

CAVL0045 

IF  (DL1.EQ.0. AND. Z1. EQ.Z2) GO  TO  600 

CA VL0046 

DLXYZ=DLXY+ (Z2-Z1)  **2 

CA VL0047 

DIN=SC«T(DLXYZ) 

CA VL0049 

IF  (ISUB.NE. 0)  GO  TO  6 

C A VLC  04  9 

c 

CA  VLOOSO 

c 

THE  FIRST  TIHE  THRU,  CALCULATE  ANGLE  OF  ELEVATION 

, THETA,  CA  V LO  05 1 

c 

AND  ANGLE  RELATIVE  TO  THE  X-AXIS,  PHI 

C A VLC  05  2 

c 

CA  VI  0053 

DLPS=DL1 

CAVL0054 

CSTH=DL1/DLN 

CA  VLC 055 

SNTH=  (Z2-Z1)  /DLN 

CAVLC056 

PPO JL= Y2- Y 1 

C A VI  0057 

IF  (ABS  (PROJL)  .LT. 1. E- 20) PPOJL  = 0. 

C A.  v L 0 0 5 8 

SNFI*EPCJL/DL1 

CAVLCdcr 

ASNF  = AES (SNFI) 

C A VLn050 

c 

CAVLOOf,  1 
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FIND  HIGH  AND  I.CV  ENDS  OF  LINE  AS  PROJECTED  ON  THE  X-Y  PLANE 
6 CONTINUE 

IF(Y1.GT.Y2)  GO  TO  1 
YH  = Y 2 
YI=  Y 1 
GC  TC  2 

1 Y H = Y 1 
YL  = Y2 

2 CONTINUE 

TEST  THE  RECEPTOR  LOCATION  RELATIVE  TO  THE  LINE  SOURCE 

XHIN=ANIN1  (XI,  X 2) 

IF  ( (XNIN-XP)  .GE.O. 5)  GO  TO  500 

RECEPTOR  IS  DOWNWIND,  FIND  DISTANCE  TO  UPWIND  END  OF  LINE 

XFAR=XR-XNIN 

STOPF  PPEVIOUS  VALUES  AND  CONFUTE  NEW  DOWNWIND  DISTANCES 
AND  TFAVFL  TINES  FOR  PSEUDO  UFXIND  END  OF  LINE 

DWDAC=DVDA 

SIGFO=SIGF 

DWDA=XFAF*SUDCY 

DVDE=XFAP+SUDCZ 

TFAR=DVDA/WS36 

TFBR=  DWDB/WS  36 

CONFUTE  UPWTND  END  DISPERSION  COEFFICIENTS 

S IGF  = SIGY (JSTAP,TFAR) 

SIGFZ=SIGZ (JSTASjTFBF) 

SIOPF  LINE  COORDINATES 

IF  (X 1 . LE . X2)  GO  TO  21 

XA  = X 2 

YA=Y2 

X E=  X 1 

YB  = Y 1 

ZE=Z1 

GC  TC  22 

21  X A = X 1 

Y A = Y 1 
XB  = X2 

Y E = Y 2 
ZF  = Z2 

22  CCNTINUE 

IF  (ISAC.EO-  1)  GD  TO  4 

ARE  Y AND  Z COORDS  OF  RECEPTOR  WITHIN  4 TINES  THE  BISPEhSION 
CCEFFICIFNT  OF  THE  Y AND  Z COORDS  OF  THE  LINE 

IF  (YF.GT.  (YH+4.*SIGF) ) GO  TC  500 
IF  (YP  . LT.  (YL-4.  *SIGF))  GO  TC  ^CO 
IF  (ZR.GT.  (Z2+4. *SIGFZ) ) GO  TO  5C0 
IF(ZR.LT.  (Z  1-4. *SIGFZ) ) GC  TO  500 

IF  (A SNF  .LT.  CAN  .AND.  ABS(SNTH)  .LT.  CAN)  GO  TO  3 
IF  (IAD.NE.0)  GO  TO  3 


CAVL0D62 
CAVL0063 
CAVL0064 
CAVLD065 
CAVL0056 
CAVL006"7 
CAVL006B 
CAVL0069 
CA  VL^O  70 
CAVLOOT 1 
CAVL0072 
CAVL007 3 
CAVL0074 
CA  VL0075 
CAVL0076 
CA  VL007-» 
CAVL0078 
CA  VLO  0’79 
CAVL0080 
CAVL008 1 
CAVL0082 
CA VL008  3 
C A VL0084 
CAVL0085 
CAVL0086 
CAVL0087 
C A VL008  8 
CAVL0089 
CAVL00Q0 
CA VI 009 1 
CA  VI 0 092 
CAVL0043 
CAVL0094 
CA.VL0C9S 

CA VL0096 
CAVL0097 
CAVL7098 
CA  VL0099 
CA  V LO 100 
CAVLO 101 
CAVlO  102 

CA  V LO  10  7 
CAVLO  104 
CAVL0105 
CAVLO 106 
CAVL0107 
CAVL0108 
CA VL0109 
CAVL0110 
CAVL0111 
CA VL0 112 
CAVL0113 
CAVLC  114 
CAVL0115 
CAV10116 
CAVL0117 
CAVLO  1 1 8 
CAVL01 19 
CAVLO 120 
CAVL0121 
C A VL° 1 22 
CAVLO 12  3 
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C ANGLE  IS  LARGE:  ARE  THE  RECEPTOR  COORDS  WITHIN  3 TIMES  THE 
C DISPERSION  COEFFICIENT  0-F  THE  LINE  COORDS. 

C 

IF  (YR.GT.  (YH+3. *SIGE) ) 30  TO  500 
IF  (YR.1T.  (YL-3.*SIGF) ) 30  TO  500 
IF  (ZR.GT.  (Z2  + 3. *SIGFZ) ) GC  TO  500 
IF(ZR.LT.  (Z1-3.*SIGFZ) ) GC  TO  500 
C 

C SET  (X,Y)  AS  POINT  ON  LINE  WHERE  IMPACT  IS  GREATEST 
C 

X = X1  + (YR-Y1)  * (X2-X1)/  (Y2-Y1) 

IF  (X.G1.XR)  GC  TO  333 
IF(X.LT.XA)  GC  TO  33 

Y = YR 

GO  TO  4 
C 

C ANGLE  IS  SMALL:  REDEFINE  L INF  COORDS  AND  SEI  (X,Y)  AS 
C HIDFOINT  OF  SEGMENT 
C 

3 IF(ASNF.LT.0.1.AND.  (ABS(SNTH) ) .LT.O. 1|  LSAC=1 
I SAC=  1 

30  X = AMIN1  (XF,XA) 

Y 1 = Y 1 ♦ (X-X1)  * (Y2-Y1)/  (X2-X1) 

Z1=Z1+ (X-X1) *(Z2-Z1)/  (X2-X1) 

X1=X 
X2  = XB 
Y2=YB 
Z2=ZB 

X=0 . 5*  (X1  + X2) 

Y=0.5*(Y1+Y2) 

GC  TC  5 
33  X=X A 

Y = Y A 

GC  TC  4 
333  X=XB 
Y=YB 
C 

C CONFUTE  DOWNWIND  DISTANCE 
C 

4 DND=XF-X 

IF  (DWD.LT. -.01)  GO  TO  30 
DWD 1 = DWD 

IF  (ISAC. NE. 1)  GO  TO  40 
DWD 1 =XF-X 1 

IF  (NSUB.LE.1)  DWD=DWC1 
C 

C CONFUTE  FSEUDO  DOWNWIND  DISTANCES 
C 

40  DWDY1  = DWDHSUCOY 
DWDY=CWD+SUDOY 
DWDZ=DVD+SUDOZ 
C 

C SET  Z COORDINATE  OF  LINE 
C 

IF  (X1.EQ.X2)  GO  TO  44 
Z=Z1+(X-X1) * (Z2-Z1) / (X2-X1) 

GC  TO  444 

44  Z = Z1+  (Y-Y1) *(Z2-Z1)/(Y2-Y1) 

444  CONTINUE 

C 

C CONFUTE  TRAVEL  TINE  AND  DISPERSION  COEFFICIENT  FOR 
C PSEUDO  DCW’NWIND  DISTANCE 


CAV1.0  12  4 
CAVL0125 
CAVLO  126 

CA  VLO 1 ?9 

CAVL'1 125 
C A V L 0 1 2 Q 
C AVL0130 
CA VLO 1 4 1 
CAVL01 32 
C A VLO  1 3 3 
C*VL013U 
CAVL0135 
CAVL0136 
CAVLn 1 37 
CA  VLn 1 36 
CAVI^I’P 
CAVLO  1u0 
C A V L " 1 4 1 
CAVL o 14  2 
CA  VI''  14  3 
CA VLO  144 
CAVL0145 
CA  V!  o 146 
CA  VLO  147 
CA  " L ° 1 4 6 
C«  VI 0 149 
CA  VL" 150 
CA VLO 15 1 
CAVLf'1s2 
CA.  VI  o 153 
CA  V L0  1 64 
CA VLO  155 
CAVT.O  166 
CA VLO 157 
C A V I. n 1 5 6 
CA VLO  169 
CA"  T. 0 1 6 0 
CA  V L" 1 6 1 
C A VLO  16 2 
CA VLO 16 3 
CA  VLO  164 
C A V L 0 165 
CAVLD166 
C A V 1 o 1 6 " 
CAVLO  166 
CAVI.C169 
CA  VLO 19  0 
CAVLO 171 
CA VLO 172 
CAVLO  193 
CA VLO 174 

CA" LC  195 
CA  VT 0196 

C A.  V l n 1 9 7 
CAVL019(3 
CA  VL7179 
C» VLO 160 
CAVL"  16 1 
CAVLO  162 
CAVT.0163 

CAV* 0194 

C A V T 114  6 
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BRANCH  IF  ANGLE  IS  SMALL  AND  LINE  SOURCE  IS  LONG. 

IF  (IAD. NE. 0)  GO  TO  4311 
IF  (ASNF.GE.CAN)  GO  TO  4312 

4311  IF  (DL1.GT.  (1.5*ELFM)  ) GO  TO  55 

CONFUTE  TFAVEL  TIME  AND  DISFEFION  COEFFICIENT  FOR  PSEUDO 
VERTICAL  DISTANCE 

4312  IF  (DWDY. EQ.DVDY1)  GO  TO  4112 
THPH=EWDY/WS36 

S IGH  = SIGY  (J  STAB  ,THR  H) 

4212  CCNTINUF 

TKPV=DKDZ/N53F 
S IG V = SIGZ (J  STA  B , THR V) 

EXPRESSIONS  TO  BF.  USED  IN  APPROXIMATIONS 

DENH2=2.*SIGH**2 
DENZ2=2. *SIGV**2 
D=SIGH*SI GV 

ARGUMENTS  OF  EXPONENTIAL  FUNCTION  FOR  VERTICAL  DISPERSION 
USING  SMALL  ANGLE  APPROXIMATION 

AFGZ1=- (ZP-Z 1) **2/DENZ2 
AFGZ2=- (ZP  + Z1) **2/DENZ2 
IF  (LSAC. EQ . 1 ) GO  TO  446 
GC  TC  445 

4111  S IGH  1 =SIGF 
GO  TO  4211 

4112  SIGH  = SIGH  1 
GO  TC  4212 

4113  SIGH1=SIGFO 
GC  TO  4211 


LARGE  ANGLE  CASE:  ARGUMENTS  OF  ERROR  FUNCTIONS  FOR 
HORIZONTAL  EISPEPSION 


445  CCNTINUF 

APG=CSTH**2*SNFI**2*SIGV**2+SNTH**2*STGK**2 
RARG  = SCRT  (ARG) 

A = FAFG/(1 .4142*1) 

AL=DLN*A 

AFG 1 = (YR-Y1) *CSTH*SNFI*SIGV**2 
A RG2 1 = (ZF-Z 1) *SNTH*S  TGH**  2 
ARG22  = - (ZR+Z1) *SNTH*S IGH* *2 
PA1--(ARG1+ARG21)/(1.4142*D*RAPG) 


CAVL0200 
CAVL0201 
CAVL0202 
CAVL0203 
CAVL0204 
CAVL0  20  5 
CAVL0206 
CAVL0217 
CAVL0208 
CAVL0209 
CAVL0210 
CAVLD211 
CAVL0212 
CAVL021 3 
CAVL0214 
CAVL021E 
CAVL0216 
CA.VL0217 
CAVL0219 
CAVL0219 
CAVL0220 
CAVL0221 
CAVLD222 
CAVL0223 
CAVT0224 
CAVL0225 
CAVL0226 
CAVL0227 
CAVLC22R 
CAVL0229 
CAVL0230 
CAVL0231 
CAVL0232 
CAVL0233 
CAVL0234 
CAVL0236 
CAVL0236 
CAVL0237 
CAVL023B 
CAVL0239 
CAVLC240 
CAVL024 1 
CAVL0242 
CAVL024  3 
CAVL0244 
CAVL0245 
CAVL0246 
CAVL0247 


r* 
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B A 2 = - (ABG1+ARG22)/(1.  4l42*D*Rf  RG) 

CA VI 0748 

C1= (Yfi-YI) **2/DENH2-ARGZ1 

CA VI 0249 

C2= (YR-Y1)  **2/DENH2-ARGZ2 

C A,rL  0 250 

c 

CA  VLD25 1 

c 

ARGUMENTS  OF  EXPONENTIAL  FUNCITONS  FOR  VEPTICAL  DISPER3ICN 

CA  w 10  25? 

. 

c 

USING  THE  GENERAL  EQUATION 

C A.  V L ° 2 5 3 

c 

C A V! 02^4 

ARGZ  1 = EA1**2-C1 

CA  V LO  255 

ARGZ2=EA2**2-C2 

C 11  V I 0 25  6 

r. 

446  IF(AFGZ1.LT.-10.)GOTO  24  11 

CAVLD25V 

" 

IF(ABGZ2.GE.-10.) GOTO  2412 

CA VLO  259 

F AC  1 =EXP (ARGZ1) 

CA VLC259 

• 

FAC2=C 

CA  ”10260 

GC  TC  39 

CA VLO 261 

• 

2411  IF  (ABGZ2.LT. -10)  GO  TO  500 

CAVL0262 

F AC  1 = 0 

CAVL0263 

FAC2=EXP(ARGZ2) 

CAVI0264 

GC  TO  39 

CAVL0?6C 

l 

2412  IF (DWD.GT. XZ)  GO  TO  100 

CAVLC  266 

c 

CAVT,r'267 

■ 

c 

DOWNVIND  DISTANCE  IS  LFSS  THAN  THE  CRITICAL  DISTANCE:  ONLY 

CA  V 1.026  R 

f 

c 

SOURCE  AND  GROUND  REFLECTION  APF  CONSIDEFED 

CA  VT.,'269 

c 

CA VLO 270 

, 

F AC  1 = E XP ( ARGZ  1 ) 

CAVLD2"7 1 

FAC2=EXP(ARGZ2) 

C»  VLO 27 2 

39  CONTINUE 

CA VLO  27  3 

4 

c 

CAVL9274 

c 

FIND  THE  LINEAR  DISTRIBUTION  OF  POLLUTION  ON  THE 

CA VL^27C 

1 

c 

RUNWAY  FOR  LANDING  AND  TAKF-OFF 

CAVL0276 

c 

CAVL02'7"’ 

l 

X SI  2= (X-XST) **  2+ (Y-YST) **2+(Z-ZSI) **2 

CAVLr'278 

X SI  = SQBT ( XSI2) 

C A V 1. 0 2 7 9 

IF (X*XND.  LT.O.OP. Y* YN C . LT . 0. OF . Z* ZND . LT.O)  XSI  = -XSI 

CA VL0290 

IF  (TAD  .NE.  0)  CALL  QNOD  (YSI , QL) 

CAVLR28  1 

QTOT=CIOT+QL*SEGL 

CAVLr'282 

c 

CA VL02R9 

c 

STORE  LAST  VALUF  OF  CPAB 

CAVL02PU 

i i 

c 

C A VI.  0 28  5 

CEA  EC  = CPAP 

CA VL0286 

L t 

IF (LSAC.EQ. 1)  GO  TO  50 

CA  VLO  ?R7 

c 

CA  VL"'  289 

c 

GENERAL  DISPERSION  EQUATION 

CAVL0290 

c 

CA VL°  290 

FJ1=FAC1*DIFEFF (9A1.AL) 

CA  VLO  29  1 

; 

FJ2  = FAC2*DIFEFF  (BA  2, A I) 

CAVT  8292 

CBAF.  = CEAP  + 0. 35355*COEF1*QI*  (F01  + FJ2)  / ( A*D) 

CA VL029  7 

| 

499  IF  (CBARO.EQ.C)  GO  TO  49 

CA  VL8  2q4 

IF (AES ( (CBARO-CBAR)/CEAR) . LE. . 00010)  GO  TO  600 

CAVL0295 

49  CONTINUE 

CA.VL8296 

IF (NSUB.GT. 1 . AND. DLPS.GT.  ( . 0 1 * DL)  ) GO  TO  60 

CA  VI.0207 

GC  TO  600 

CAVL0298 

c 

C ».  V ! 6 29  9 

c 

SHALL-ANGLE  APPIOXIMATION 

CAV! 0380 

c 

CA  V L 7 10  1 

50  ARGYY=- (YP-Y1) ♦♦2/DENH2 

CAVL0302 

IF (APGYY.LT. -1C.)  GO  TO  500 

CA VLO 3? 1 

FAC  = 0 . 5*  (FAC1  + FAC2) 

CA  VLO  30  4 

• 

BRAC=EXP ( AFGYY) 

CAVT  0905 

CEAF  = CPAR  + COEF2*QL*DL  N*FAC*BP AC/D 

CA  VI  0 306 

GC  TC  499 

CA  VI 9 30  7 

c 

CAVL9398 

c 

ANGIE  IS  SHALL  AND  SOUFCE  IS  LONG 

C A VL8  390 

k.  i 

- “ . J 

S')  ISU6=1 
XFS=X2-X1 
YRS=Y2-Y1 
ZES=  Z 2- Z 1 
X2=  X 1 

Y 2 = Y 1 
Z2  = Z 1 

COMPUTE  COORDINATES  FOP  NEXT  LINE  SEGMENT 

60  NSUB=  1 . +DLPS/FLEM 
FSUE=NSUB 
SEGl=DLRS/RSUP 
DELX=XFS/PSU3 
DELY= YRS/FSUE 
DELZ=ZKS/R5UP 
X 1 = X 2 

Y 1 = Y 2 
Z1=Z2 

X2=X2+TELX 
Y2=Y2+DELY 
Z2=Z2+DELZ 
DLFS=CLFS-SEGL 
X FS  = X FS-DFL  X 
YFS=YFS-DELY 
ZFS=ZPS-DELZ 
X= . 5*  (X1  + X2) 

Y = . 5*  (Y1  + Y2) 

Z = . **  (Z1*Z2) 

GO  EACK  TO  COMPUTE  CONTRIBUTION  FROM  NEXT  SEGMENT 
GC  TC  5 

DOWNWIND  DISTANCE  IS  GFFATEF  THAN,  BUT  LESS  THAN  TWICE,  THE 
CRITICAL  DISTANCE.  LINEAR  I NTFR  POLATION  IS  USED 


IOC  YL  = Y 1 
ZL  = Z1 

IF  (Z1  .LE.  Z 2)  GO  TO  105 
YL  = Y 2 
ZL  = Z 2 

1C  5 FAC3=0.5*SIGV/(COEP1*HLTPM) 

IF  (IVC.GT. 2. *XZ)  GO  TC  20C 

PENZL=0.47*HLirM 

DENZL2=DENZL**2 

IF  (I  SAC. FQ . 1 ) GO  TO  101 

102  TI=XZ/VS36 

DFNHL2  = 2.*STGY  (JSTAB,TL) **2 

DENO=CSTH**2*SNFI**2*DENZL2  +SNTH**2*DENHL2 
AFGZ  1=- < (YP-YI ) *SNTH-  (ZR-ZL) *CSTH*SNFI)  **2/DENO 
APGZ2  = - ( (YR-YL)  *SNTH-  (ZR  + ZL) *CSTH*SNFI) **2/DENO 

GC  TC  103 

101  AFGZ1  = - (ZF-ZL)  **2/DENZL2 
AFGZ2  = - (ZF  + ZL) * * 2/DENZL2 

103  FAC1  = EXP  ( ARGZ1) 

F AC 2 = EXF  (ARGZ2) 

FA.C1  = FAC1  + (DWD-XZ) * (F  AC3- FAC  1 ) /XZ 
F AC2  = F A.C2  + (D9D-XZ)  * (FAC3-FAC2)  /XZ 
GC  TC  39 


CA  VLO  3 10 
CAVL031 1 
CA VLO  31 2 
CAVL0313 
CAVLO  3 1 4 
CA VL0315 
CA  VLO  3 1 6 
C A VLO  3 1 7 
CAVLO  319 
CAVL0319 
CAVLO  320 
CA  VLO  32 1 
CAVL0322 
CAVL0323 
CA  VLO  324 
CAVLO  325 
CAVLO  326 
CA VL0327 
CA  V LO  32  8 
CAVLO  329 
CAVL0330 
CAVLO 331 
C A VLO  3 3 2 
CAVLO  33  3 
CAVL0334 
CA VL" 335 
CAVLO  3 36 
CAVL0337 
CA.  VLO330 
CA  V LO  3 ,0 
CAVLO  340 
CAVLO  34  1 
CAVE"  342 
CAVLO  34  3 
CAVLO  344 
CAVLO  345 
CAVLO  346 
CAVLO  347 
CAVLO  348 
CAVLO  349 
CAVLO  350 
C A VL°  35  1 
CAVLO  352 
CAVLO  ’5R 
CAVLO  354 
CAVL0 35R 
CA  V LO  356 
CAVLO  35’ 
CA”LO  358 
CAVL’359 
CAVLC  360 
CA  V LO  36  1 
CAVLO. 36 2 

CA  V LO  36  3 
CAVLO  364 
C A ”LC  36 ^ 
CA. VT  0 366 
CAVLO  367 
CAVLO  368 
CAVLO  369 
CA  V LO  3 ’0 
CAVLO  371 


c 

c 

c 


c 

c 

c 

c 


DOWNWIND  DISTANCE  IS  BEYOND  2 TINES  THE  CRITICAL  DISTANCE, 
UNIFOPM  NIXING  IS  ASSUNED 

200  F AC1=FAC3 
FAC2=F  AC3 
GO  TO  39 

500  IF  (DLPS.LT.  (.C1*DL) ) GOTC  600 

IF  (ISAC.SQ.  1 . AND.NStJB.  EQ.  0)  GO  TO  55 
IF  (NSUB.GE. 1)  GO  TO  60 
6C0  IF  (NSUB.  NE.  t.OR.  XNAX.GE.  XPI  QTOT=1.0 
IF  (CTOI.EQ.O.O)  QTOT=1.0 

NORHALIZE  CBA  E TO  THE  TOTAL  POLLUTANT  DENSITY  CALCULATED 
ALONG  THE  LINE 

CAVL=CBAR/QTOT 

RETURN 

END 


C»  VLO 372 
CA VLO  37  1 
C?  «LO  37<* 
CAVL0375 
CAVLC  77  6 
CAVLO  37 7 
CAVLr'l7fl 
CAVLO  37P 
CP  V Lr 3«0 

CAVL 0181 

CAVLO  3P2 
CAVL0393 
CAVLO  3 P a 
CAVLO  385 
CAVI0386 
CA VL0337 
C A 7 L 0 3 a 8 
CAVLO  38° 
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SUBROUTINE  CLASSE 


Purpose: 

To  print  an  error  message  if  the  wrong  ICLASS  value  is  input 
to  one  of  the  airbase  non- aircraft  or  environ  emission  distri- 
bution subroutines. 


Input: 

None 

Output: 

A message  indicating  the  value  of  ICLASS  set  by  the  code  and 
the  value  supplied  by  the  user. 


Subroutines 

Called: 


None 


CLASEOOO 
CLASEOO 1 
CLASE002 
CLASEOO  3 
CLASE004 
C LASE005 
CLASE006 
CLASE007 


IhlS  FCUTINE  PRINTS  THE  ICLASS  EBROR  MESSAGE 


PRINT  1,  1,0 

FORMAT (17H0ICLASS  SHOULD  EE,I4,18H,  INPUI  CARD  READS, 14) 

sicr 

END 


SUBROUTINE  DEPART 


Purpose: 

To  calculate  the  points  in  the  runway  roll  and  climbout 
inodes  as  a function  of  aircraft  type  using  current  meteor- 
ological conditions  and  airbase  specific  pressure  altitudes 
and  airbase  dependent  basic  aircraft  parameters. 


Input: 

Basic  aircraft  data,  current  meteorological  conditions, 
runway  data,  aircraft  identification. 


Output: 

Points  in  departure  path  as  a function  of  runway  and 
aircraft  type. 


Subroutine 

Calleir 


Function  RRDIST. 


on  non  non  onn  r»r»r>r> 


— ■ !■■■>■» 


SUBROUTINE  DEPART  (N, I) 

THIS  ROUTINE  CALCULATES  THE  POINTS  IN  THE  DEPARTURE  PATH 
AS  A FUNCTION  OF  BUNN  AY (N)  AND  AIRCRAFT  TYPE  (I) 

REAL  LNCSPD 
INTEGER  ENGNO 

COHHON  / HET  / HS , WSH P H, INS , HD, IN D, SI NEVD,CVS END, J3 IhB, HLID. TEMF, 

. TEHK 

CCHHCN  /ANNHET/  TBAR , ADD, P, PA, WSBAR, DIBAR 

COHHON  / ACEDB 1/  ACEHFC  (8, 10,6)  , ASCNT1  (8) , ASCNT2  (8)  ,TXISPD (8)  , 

. LNDSPD (8) , APSPD1 (8) , AFSPD2(8) ,COHT1 (8) ,TOSPD (8 ) , COSP D1 (8) , 

. COSPC2  (8) , SRTUPT  (8 ) ,DSCNT1(6) ,EGCHKT(8) , SHTDN  T ( 8)  ,DSCNT2(b)  , 

. APFHT,APPHT2(8) ,CLHB  Kl,  TO  NT  (8) , E NG NO (8 , 2 ) , IDBR (8) 

COHHCN  /ACEDB2/  N ACTY P , NRNHYS , NPK AR , I EGFLG, IACTYP  (8) , A.NNAPS  (8) , 

. ANNDEP  (8) , ANNTGO (8) , ARRFCN (24 , 8 , 6)  , DE PFCN ( 24 ,8 , 6)  ,TGO(3,4, 8) , 

. DI SBN W (6) ,RNRY(7,6), IUSWD(20,6)  , ACFUEL  (8) , ARFLVT (8)  , DPFLVT(8) , 

. ACSPII  (8) , ARSVEH (6 , 8, 5) ,DPSVEH (6,8,5) , NIBTT (6)  , N IBSEG (8,6)  , 

. I IES EG ( 1 6 , 8 , 6)  ,IDIBTW  (8,6) .TTARFR (8,8,6)  , NGBTT  (6 ) .NOBS EG  (8, 6) , 

. IOBSEG  (16,8,6)  , IDOBTW  (8 , 6) ,TT DPFR (8, 8, 6) , NPASQ (6) ,IDPPKA(b)  , 

. PARE A (6,3,3) , I DIBP A (8,6)  ,IDOBPA  <8,b)  , NLSEGS, kCLNSG ( 1 2 5)  , JFS1  (b) 
BD  = RNNY  (7,N) 

WSPD=NS*1 . 9426*COS (HD-RD) 

HE IS  12=BRDIST(IDRR (I)  , PA , TEHF , TON T (I ) ,WSPD)  *3.048E-4 
X A = SI N (RNN Y (7, N) ) 

Y A=CCS  (BN  HY  (7 , N ) ) 

X = RNNY  (2, N) 

Y = RNWY  (3 , N) 

Z = RNHY (4, N)  /1C00. 

DIS23=COHT1  (I)  /SIN  (ASCNT1  (I)) 

DIS3U=  (CL HBHT-COHT1 (I) ) /SIN (ASCNT2 (I) ) 

HCIS23=COHT 1 (I ) /TA N ( ASCNT 1 (I) ) 

HCIS34=  (CLH  BHT-COHT 1 (I) ) /TAN (ASCNT2(I) ) 

START  OF  RUNWAY  ROLL  EATA 

DEPFCN(1,I,N)  = X 
DEPFCN (2, I, N) = Y 
DEPFCN(3,I,N)=Z*1000. 

EEPFCN(4,I,N)=0.0 

DEPFCN  (5,1 , N)  =HDIS12 

DEPFCN  (6,I,N)=2.0*HDIS12/TOSPD(I) 

FCINT  CF  LIFTOFF  DATA 

DEPFCN  (7,1, N)  = X + HDIS12*XA 
DEPFCN  (8,I,N)=Y*HDIS12»YA 
DEPFCN  (9,1 , N) =Z*1000. 

DEPFCN  (10,I,N)=TOSPD(I) 

DEPFCN (1 1, 1,N)  =DIS23 

DEPFCN(12,I,N)=2.0*DIS23/ (TOSPD(I) ♦COSPD1 (I)  ) 

END  CF  CLIHB1  FCINT  DATA 

DEPFCN  (13,1, N) =DEP FCN (7 , 1 , N)  +HDIS23*XA 
DEPFCN  (14, 1,  N)=  DEPFCN  (8,I,N)  +HDIS*3*YA 
CEP FCN  (15, 1, N) =COHT 1 (I)*1000. 

DEPFCN  (16,1  ,N)  = COS  PD  1 (I) 

DEPFCN (17,I,N)=DIS34 

DEPFCN (18,1, N)  =2. 0*DIS 34/ (COSPD1 (I) *COSPD2  (I) ) 

END  CF  CLIH BOUT  POINT  DATA 


DEPRT000 
DEPRT03  1 
DEPRT30 2 
DEPPTOO  3 
DE°RT004 
DEPBT0C5 
DEPRT006 
DEPRT007 
DEPRTO08 
DEPRT009 
DEPRTO  10 
DEPFT01 1 
DEPPT012 
DEPRTO 13 
DEPPT014 
DEPPT01 5 
PEPFTC  16 
DEPRT017 
DEPRTO  1 8 
DPPRT019 
DEPRT020 
DEPRT021 
DEPRT022 
DFPKTO  2 3 
DEPRTO  24 
DEPRT025 
DEPRTO  26 
DEPRT027 
DEPRT028 
CEPRTC29 
DEPRTO  30 
DEFRT031 
DEPPT03  2 
DEPRTO  3 3 
DEPPT034 
DEPPTO  35 
DEPRT036 
DEPRTC37 
DEPRT038 
DEPRT039 
DEPRT040 
DEPPT04 1 
DEPRT042 
DEPPT043 
DEPRT044 
DEPRT045 
DEPRT04  6 
DEPRTO  4 7 
DEPRT048 
DEPRT049 
DEPPT050 
DEPRT051 
DE  P RT  05  2 
DEPPT053 
DEPRT0e'4 
DEPRT055 
DEPRT056 
DEPPT057 
DEPRT058 
DEPRTC6Q 
CEPPTObO 
DEPPT06 1 
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c DEPRT062 

CEFFCN  (19, 1, N) =CEPFCN  (13,I,N) +HDIS34*XA  DEPRT063 

DEFFCN  (20, 1, N)  =DEPFCN  (14,I,N) +HDIS34*YA  DEPRT064 

tCFFCN  <21 ,1 , N) = Cl H 9 HT  ♦ 1000.  DEPRT065 

DEFFCN  (22,I,N)=COSPD2  (I)  DEPRT066 

BETUFN  DEPRT067 

END  DEPRT068 


I 
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The  difference  between  the  error  functions 


Procedure : i j 

1.  If  PH  s .05,  the  formula  given  in  the  Handbook  of  Mathematical 
Functions,  National  Bureau  of  Standards,  Applied  Mathematics 
Series  55  is  used: 

DIFERF  = 1.12838-PH.e'X  [l-PH-X+(2-X2-l) -PH2/3] 

2.  If  PH  > .05  and  X and  X+PH  are  of  different  sign: 

DIFERF  = erf (X+PH)  - erf(X) 

3.  If  PH  > .05  and  X and  X+PH  are  both  negative: 

DIFERF  = -l.*[erfc(-X)  - erfc(-X-PH)] 

4.  If  PH  > .05  and  X and  X+PH  are  both  positive: 

DIFERF  = erfc(X)  - erfc(X+PH) 


Function 

Called: 

ERF,  ERFC 
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non  non  nnnn  nnnn 


FUNCTION  DIFERF  (X , PH) 

THIS  FUNCTION  FINDS  THE  DIFFERENCE  BETWEEN  TWO  ERROR  FUNCTIONS 
USING  VARYING  HFTHODS  BASED  ON  THE  SIZE  OF  THE  ARGUMENTS 

DIFERF=0. 

IF  (PH . FQ. 0.0)  GO  TO  50 
TF  (ABS(X)  .GT.  10.0)  GO  TO  50 
IF  (PH. GT. 0.05)  GO  TO  10 

USE  METHOD  OUTLINED  IN  HANDBOOK  OF  MATH  FUNCTIONS,  NATL 
BUREAU  OF  STANDARDS,  APPLIED  MATH  SERIES  55 

DIFERF= (1 . 12838*PH/EXP(X**2) )*(1.-PH*X+(2.*X**2-1.l*PH**2/3.) 
GO  TO  50 

DIFFERENCE  IS  TOO  LARGE,  MUST  USE  ERF  OR  ERFC 
10  XPH=X+PH 

XTEST= AMI N 1 ( ABS (X) , ABS ( X+PH) ) 

IF  (XTEST.GE.5.0)  GO  TO  50 
TF  (X *X°H . LT . 0 . 0)  GO  TO  40 
IF  (XTEST.LT. 0.47)  GO  TO  40 

CAN  ONLY  REACH  HERE  WHEN  X AND  XPH  HAVE  SAME  SIGN 

IF  (XPH. GT. 0.0)  GO  TO  20 
SIG  N= - 1 . 

X 1=-XPH 
X2=-X 
GO  TO  30 
20  STGN=  1 . 

X1=XPH 
X 2 = X 

30  DIFERF=SI GN* (ERFC (X2)  - ERFC (XI)  ) 

GO  TO  50 

40  DIFEPF=ERF  (XPH)  -ERF  (X) 

50  RETURN 
END 


DI FER000 
DIFEROO  1 
DIFER002 
DIFEROO  3 
DIFER004 
DTFER005 
DTFER006 
DI  F ER  00  7 
DIFEROO  8 
DIFER009 
DIFER01 0 
DIFER01 1 
DIFER01 2 
DIFFR01 3 
DI F FRO  1 4 
DTFER015 
DIFER01 6 
DIFER017 
DIFER01 8 
DTFER019 
DIFER020 
DIFER02 1 
DTFEP022 
DIFER92  3 
DIFER024 
DIFER025 
DTFER026 
DIFER027 
DIFER028 
DTFER02U 
DIFER030 
DIFER03  1 
DT  F PR0  3 2 
DTFER033 
DIFER034 
DIFER035 
DIPER036 
DI FER  037 
DIFER038 
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SUBROUTINE  EMISAR 
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c 

t 

c 

c 

c 

c 

c 

c 

c 

c 


? UR  ROUTINE  EM1SAR(MAXN,ARRAY,I1,I2) 


This  ROUTINE  ACCUMULATES  EMISSIONS  EROM  ANY  ACTIVITY 
OTHERS  CONTAINED  IN  THE  SAME  AIRBASE  AREA  OR  LINE. 


WITH 


M AXN 

ARRAY 

11,12 

NSPCE 

LOCI 

SORCE  (2 , N) 


NO.  OF  SOURCES  IN  AN  ACTIVITY 
SPECIFIED  AREA  OR  LINE  OUTPUT  ARRAY 
DIMENSIONS  OF  ARRAY 

POINTER  TO  LOCATION  OF  SOURCES  IN  SORCE 
POINTER  TO  LOCATION  OF  LISI  OF  EMISSIONS  IN 
POINTER  TO  LOCATION  OF  SOURCE  AREA  OR  LINE 


COMMON  /SRCE/  N PLTS , NENPT  , NE NAR , NENLN, N AB PT , N ABAR , N ABLN, 

. NACET,NACAR,NACLN, F NET  (16,100) , ENAR  (11,100) , ENLN  (14,20) , 

ABET (16, 150) , ABAR (1 1, 100) , ABLN (14, 100) 
CCMMCN/JUNK/DAYS,LSRCE,NSRCE,SORCE(17,300)  ,SORGH  (10  ,200) 

. ,LCC1 , LCC2 ,NGEOM,IPT 
DIMENSION  ARRAY  (II, 12) 

LS  RCE=  NSRCE+ 1 
NSRCE=NSRCE*MAXN 


DC  10  N=LSRCE, NSRCE 
J=SORCE (2,N) 

DC  10  1=1 , NFLTS 

ARRAY  (I  + LOC1,J)=APPAY  (I  + LCC1 ,0) + SORCE  (1  + 2 ,N) 
10  CONTINUE 
RETURN 
END 


EHISF000 
EHISR001 
EHISR002 
EMISR003 
EMISR004 
EHISRC05 
EHISR006 
EMISR007 
ASRAY  EMISR008 
EM  IS  R00  9 
EMI SRO 10 
EMISR01 1 
EMISR012 
ENISR013 
EMISR014 
EMISR015 
FHISP016 
EMISRO 17 
EMISR  01 8 
EM  IS  PO  1 9 
EMISR020 
EMISR021 
EMISR022 
EMISP023 
EMISR024 
EMISR025 
EMISR026 
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SUBROUTINE  ENARAY 


Purpose: 

1.  To  read  from  the  master  source  tape  all  data  needed  to 
define  environ  point,  area  and  line  sources. 

2.  To  compute  the  emission  rates  due  to  point  sources, 
stationary,  mobile,  land  use  or  combined  area  sources 
and  roadway  and  non- roadway  line  sources. 

Input: 

If  the  diurnal  distribution  cards  are  input,  an  additional 
parameter,  IMETH,  is  input  here  to  choose  the  method  of 
distribution  of  emissions  from  those  land  use  or  combined 
area  source  activities  not  using  the  default  of  a uniform 
distribution. 

Output: 

The  arrays,  ENPT,  ENAR,  and  ENLN,  are  filled  with  geometry 
and  emission  data  for  all  environ  sources. 


Subroutines 

Called: 

METHA,  METHB,  METHC,  METHE 
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READ  ITAPE  FOR  ALL  ENVIRON  AREA  SOURCE 
INPUT  AND  EMISSIONS  RESULTS,  TOGETHER 
WITH  TYPE  COUNTERS 


READ  ITAPE  FOR  ALL  ENVIRON  LINE  SOURCE 
INPUT  AND  MISSIONS  RESULTS,  TOGETHER 
WITH  TYPE  COUNTERS 


SUB  FCUTINE  ENAPAY 
C 

C T Hla  SOUTINE  COMPUTES  THE  EMISSSION  RATES  FOR  ALL 

C ESVIFCN  SOURCES 

C 

COMMON  / DEFALT  / IT APE , ACLNDY , ACLNDZ , ALPH A (7 ) , BETA  (7) , FLDENS (7) 
COM  MC  N/JU  NK/D A YS ,LSRCE,NSRCE,SORCE(17,  300) , SORGM (10,  200) 

. , LOC  1, LCC2, NGEOM, IPT 

CCMMCK/MCNMET/TMBAR,V.'SMBAR, AMDMBR, DTM EAR 
COMMON/MET/WS, WSMPH,IWS,WD,IWD,SI NHD , COS WD, 

. JSTAE,HLID,TEMF,TEMK 

COMMON  /PERIOD/  IMONTH , NO  DAYS , IDA Y, IHR 1 , IHR2, 1FLAG, JFL AG 
COMMON  /DSTRBT/  ACMO ( 1 3, 8)  , ACDY (2, 8) , ACHR (24, 8) , VHMLMO  (1 3) , 

. VHMLDY  (2) , VHMLHR (24)  .CVABMO (13)  , CVABDY  (2)  ,CVABH3  (24)  ,CVENHO  (13)  , 
- CVENDY  (2)  , CVEN HR (24)  ,FLMC  (13,7)  , FLDY  (2,7) ,FLHR  (24,7)  ,NC1 
COMMON  / S P C E/  NPLTS,NENPT,NENAR,NENLN,NABPT,NABAR,NABLN, 

. N ACFT,N AC AR,NACLN,FN PI (16,100) , E NAR ( 1 1 , 1 00 ) ,ENLN (14,20) , 

ABPT(16, 150) , ABAR (11, 100) , ABLN (14,100) 

C 

C****FOINTS 

C 

READ  (IT  A PE)  NFNPT,  NTOI,  ( (SORCE  (I  ,N)  ,1-1,  NTOT)  , N=  1 ,NENPT) 

IF  (NENFT.EQ.C)  GO  TO  100 
ICL  ASS  = 20 1 
ICC  1=10 
LCC2=  1 1 
NGEOM=9 
11=16 
12=100 
I FT=  1 
N S RCE  = 0 

CALL  MET  HA ( NENPT, ENPT , 1 1 , 1 2, ICLA SS) 

C 

C**** AREAS 

C 

100  READ  (ITA  PE)  NEN AR, N TO T , IOPT , N MAX  1 , NMA X2 , 

1 ( (SCRCE  (I , N)  ,1=1, NTOT)  , N=  1 , NEN  AR) 

IF  (NENAP.EQ.O)  GO  TO  300 
LCC 1 =5 
LCC2=7 
NGECM=5 
I FT  = C 
11=11 
12=100 
NSRCE=0 

GC  TC  (110,120, 130) , IOFT 
C 

C****CPTION  1 STATIONARY  AREAS 
C 

110  ICL ASS=202 

IF  (NBAX1.GT.0) 

1 CALL  METHB  (NMAX1,ENAR, 11,12, ICLASS) 

C 

c****CPTION  1 MOBILE  AREAS 
C 

IF  (NMAX2.GT.0) 

1 CALL  HETHE(NMAX2,ENAR,CVFNMO, CVENDY, CVENHR, II, 12) 

GC  TC  300 
C 

(;♦*** CPTICN  2 OF  3 LANE  USE  OP  COMBINED  AREAS 
C 

120  ICLASS=203 


ENAPY000 
ENARY001 
ENARY002 
ENARY003 
ENAPY004 
ENARY005 
ENAPY006 
EN  A RY  007 
FNARY008 
EN  A RY  009 
ENARY010 
ENARY011 
ENARY012 
EN  A RY  01 3 
ENARY014 
ENARY015 
EN ARY  016 
ENA  RY  0 17 
ENARY018 
EN  ARY  0 1 9 
ENARY020 
EN  ARY  0 2 1 
ENARY022 
ENARY023 
EN A RYO  24 
ENARY025 
ENARY026 
EN A RY 02 7 
EN A RY  02  8 
EN  ARY  029 
ENARY030 
EN  A RYO  3 1 
PN  A RYO  32 
EN APY033 
ENAPY034 
EN  ARYO  35 
EN  A R YO  36 
EN  ARY  0 37 
E NA  RY 0 38 
ENARY039 
ENARY040 
ENARY041 
ENARY042 
ENARY043 
EN  ARY  04  4 
EN  A RY  04  5 
ENAPY046 
EN  A RY  047 
ENARY048 
EN  A RY  0 49 
ENARY050 
ENARY051 
ENARY052 
ENARY053 
ENARY054 
ENARY055 
ENARY056 
ENARY057 
ENAPY058 
ENA  RY  059 
ENARY060 
ENARY061 


non 


M.(.IHUHWli'4WW.MJ  . .1  III.U.I.. 
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GC  TO  200 
130  ICLASS=204 

200  IBETH=1 

IE  (JFLAG. EQ.O)  BEAD  201,IBETH 

201  FCRBAT  (14) 

IF  (IBETH.EQ.1)  CALL  BETH A (NB AX  1 , ENAR , 1 1, 12, ICL ASS) 
IF  (IHETH.EQ.2)  CALL  HETHC  (NBAX1 , ENA R , 1 1 , 12 , ICL ASS) 


C****LINES 

NB  AX  1 


NO.  OF  ROADWAY  LINES 


NHAX2  = NO.  OF  NON-ROADWAY  LINES 

300  READ  (ITAPE)  NE NLN, NTOT, NB AX1 , NH AX 2, 

1 ( (SORCE (I, N)  ,1=1, NTOT)  , N = 1 , NENLN) 

IF  (NENLN. EQ.O)  GO  TO  400 
LCC1=e 
LCC2=10 
NGEOB=8 
NSRCE=0 
11=14 
12  = 20 
IET  = C 

IF  (NBAX1.GT.C) 

1 CALL  BETHE(NBAX1,ENLN,CVENNO,CVENDY,CVENHfi,I1,I2) 

IF  (NHAX2.EQ.C)  GO  TO  40C 

ICLASS=206 

IHETH=1 

IF  (JFLAG.EQ.O)  BEAD  201,I«ETH 

IF  (IBETH.EQ.1)  CALL  BET H A (NB AX 2, ENLN , 1 1, 12 , ICL ASS) 
IF  (IBETH.EQ.2)  CALL  BETHC  (NBA X2 , ENLN , I 1 , 12 , ICL ASS) 
400  RETURN 
END 


ENARY062 
ENARY06  3 
ENARY064 
ENARY065 
ENARY066 
ENARY067 
EN ARY068 
ENA  PY  069 
EN ARYC70 
EN  A RY  07  1 
FNAFY072 
FN  A RY  07  3 
ENARY074 
EN ARY075 
ENA  RY076 
ENA  RY  077 
ENARY076 
FN ARYC79 
ENARY08C 
EN  A RY  0 8 1 
ENAPY082 
EN  A RY  08  3 
ENA  RY084 
ENARY085 
EN APY086 
ENARY037 
ENAFY088 
ENARY089 
EN  A RY  090 
ENAPY091 
ENARY092 
EN ARY093 
EN  A R Y 094 


Input : 


Output : 


Subroutines 

Called: 


SUBROUTINE  INDINP 
ENTRY  DEPINP 


To  print  the  input  parameters  for  both  wind  independent  and 
wind  dependent  sources. 


All  source  parameters. 


All  source  parameters  with  appropriate  title  information. 


imfrafttiT  'iliTiilDlliai  BUT  Mr ~~ 
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SUBROUTINE  INDINP 
C 

C THIS  ROUTINE  PRINTS  ALL  THE  SOURCE  INPUT 

C 

REAL* 8 SORNAH 

CCHHCN  /BET/  VS , NS H EH , INS , WD, I WD, SI NEWD ,COS E WD, JST AB , HLID, T E ME 
. ,TEHK 

COMBCN  /PERIOD/  IHO, NCDA YS  ,ID Y , IHR 1 , I HR2 , IF  LAG , OFL AG 
COHHCN  /SRCE/  N POL , NE KET , N EN AR , N ENLN , N ABPT, N AB AR , N ABL N , N ACPT , 

. N AC AR , N ACLN , ENPT(16, 100)  , ENA R ( 1 1 , 1 00)  , ENLN  (14,20)  , A BPT  ( 16 , 1 50) , 
. ABAR  (11,100)  , ABLN (14 ,100)  ,ACPT  (1o, 1) , ACAB(1 1,24)  , ACL N ( 18 , 25 0) 
DIMENSION  SORNAH  (3) 

DATA  SCRNAH  / 8HENVIRON  , 8HAI PBA SE  , 8HAI RCR  AFT  / 

C 

C AT  THIS  ENTRY  ALL  HIND  INDEPENDENT  SOURCES  ARE  PRINTED 

C 

ENLNA-1.0 
WRITE  (6,200) 

IF  (NENET.EQ.0) GC  TO  11 
WRITE  (6, 100) SORNAH  (1) 

DC  1 I=1,NENPT 

1 WRITE  (6, 101) I,  (ENPT(J,I)  ,0=1,4) , (ENPT (0,1) , 0=6,8)  , (ENFT(J,I)  , 

. 0=10 ,15) 

11  IF  (NENAF.EQ.C) GO  TO  12 
WRITE  (6,110) SORNAH (1) 

DC  2 1=1 , NENAR 

2 WRITE  (6, 1 1 1) I,  (ENAR  (J,I)  ,0  = 1,4) , (ENAR  (J,I) , J=6, 10) 

12  IF(NENLN.EQ.O) GO  TO  13 
WRITE  (6,  1200)  SORNAH(I) 

DO  5 1=1, NENLN 

WRITE  (6,1211)  I,  (ENLN  (0,1)  ,J=1,4)  , (ENLN  (J,I)  ,J  = 9, 13) 

5 WRITE  (6,  1222)  ( ENLN  (0 , 1)  , 0=6 , 8) 

13  IF  (NAEPT.EQ.O) GO  TO  14 
WRITE  (6,100) SORNAH  (2) 

DC  3 1=1, NABPT 

3 WRITE  (6,101)1,  (ABPT  (0,1)  ,0=1,4) , (ABPT  (0 , I) , 0 = 6, 6)  , ( ABPT (0, I ) , 

. 0=10,15) 

14  IF  (NABAR.EQ.O) GO  TO  15 
WRITE  (6 , 1 10 ) SCR  NAM (2) 

DC  4 I=1,NABAR 

4 WRITE  (6,1 11 ) I, (ABAR  (0 , 1) , 0= 1 , 4) , ( AB AR (0 , I) , 0 = 6, 10) 

15  IE  (NABLN . EQ . 0) GO  TO  16 
WRITE  (6 , 1200)  SCRNAH ( 2) 

DC  6 1=1 , NAELN 

WRITE  (6, 121 1)  I, (ABLN  (0,1)  ,0=1  ,4)  , (ABLN  (0,1) ,0  = 9,13) 

6 WRITE  (6,1222)  (ABLN  (0 , 1) , 0=6, 8) 

16  CONTINUE 

100  FCRHAT  (1H0, A8 , 1 4 H POINT  SOURCES/ IX, 119(1H-)/ 

. 8X,  1HI,  11X,8HGEOHETRY,11X,22HI  STACK  PARAHETERS  I,4X,1HI/ 

. IX  ,8HSOURCE  I,3X, 1 HX  , 8X , 1 HY , 7X , 1 HZ , 3 X , 12 HR IDTH  I T EH P , 4X , 3H VEL, 
. 3X , 1 1 HDI AH  I PR  I, 13X,28HEHISSIONS ( HICROGR AHS/SECON D) / 

. IX , 1 4HNUHBER  I (KH) ,5X,4H(KH) ,4X,25H(M)  (H)  I(D£G  K)  (H/S) , 

. 3X, 10H (fl)  IFLAGI,4X,2HC0,9X,2HHC,8X,3HN0X,9X,2HPT,bX,3HS02/ 

. IX, 119(1  H-)) 

101  FORHAT (16, IX, 2F9. 2, 2F7. 1,F7.0,2F7. 1 ,F 4 . 0 , 5 ( 1 PE  1 1 . 3) ) 

110  FCRHAT  (1H0,A8,13H  ARFA  SOU RCES/ 1 X , 94 ( 1 H-) / 

. 8X,  1 HI, 11X,8HG£OHETRY,11X,1HI/ 

. IX, 8H SOURCE  I,3X,1HX,8X,1HY,7X,1HZ,4X,6HSIDE  I, 

. 14X,28HEHISSIONS(HICROGRAHS/SECOND)/ 

. 1 X , 1 4HNUHBER  I (KH)  , 5X,  4H(KH)  ,4X,3H(H)  ,4X,5H(H)  I, 

. 5X, 2HCO, 9X,2HHC,8X,3HNOX,9X,2HPT,8X, 3HS02/ 1 X , 94 ( 1h~) ) 

111  FCRHAT (I6,1X,2F9.2,2F7.1,5  (1PE11.3) ) 


88 


L _ ^ ,, 


INDIP000 
INDIPCO  1 
INDIP002 
I NDI POO  3 
INDIP004 
INDIP005 
INDIP006 
IN  DIP007 
INDIPOOR 
INDIP009 
I NDI PO  10 
INDIP01  1 
INDIP012 
INDIP01 3 
INDIP01 4 
INDIPO  15 
INDIP01 6 
INDIPO  17 
INDIP018 
INDIPO  19 
INDIP020 
INDIPO  2 1 
INDIP022 
INDIP023 
INDIP024 
INDIP025 
INDIP026 
INDIP027 
INDIP028 
INDIP029 
I NDI PO  3 0 
INDIPO  3 1 
INDIP032 
INDIP033 
INDIP034 
INDIP035 
INDIP036 
I ND I PO  37 
INDIP038 
INDIP039 
INDIP040 
INDIP04 1 
INDIP042 
INDIP043 
INDIP044 
INDIP045 
INDIP046 
INDIP047 
IN  DIP04  8 
INDIP049 
INDIP050 
INDIP051 
INDTP052 
INDIP053 
INDIP054 
INDIP055 
INDIP056 
INDIP057 
INDIP058 
INDIP059 
INDIP060 
INDIP06 1 


non 


PMJPJMP 


120  FCRBAT  (1HC, AS, 13H  LINE  SOU PCES/ 1 X , 1 23 ( 1 H-) / 

. 8X  , 1 HI , 11X,8HGEOBETRY,11X,1HI,10X, 1HI,54X, 15HI  AIBCHAFT  ONLY/ 

. IX  , 8HS0URCE  I,  3X,  1 HX  , 8X , 1HY,7X,1H2>,3X,18HbIDTH  I VELOCITY  I, 

. 1 3 X ,2 SHE HISSIO NS  ( NIC RCGR ABS/S ECOND)  , 13X, 15HI  LENGTH  TIHE/ 

. IX,  14HNUBBER  I (KB)  , 5X, 4H (KM) , 4X,23H (M)  (H)  I (KN/HB)  I, 

. 5X,2HCO,9X  ,2HHC,8X,3 HNOX ,9X, 2HPT,8X, 3HS02, 3X, 15HI  ( KH)  (HB)/ 

. IX, 123(1  H-)) 

121  FORBAT  (16, 1X,2F9.2, 2F7. 1,6  (1PE11 .3)  ,0PF7.2, 1PE11.3) 

122  FCBBAI  (7X,2F9.2,F7. 1 , 7 X , 1 PE1 1 . 3) 

1200  FCBBAT  (1H0, A8, 13H  LINE  SOURCE  S/1  X ,9 6 ( 1 H-) / 

. 8X  , 1 HI , 1 1 X , 8HGECHET  P X , 1 2X , 1 H 1/ 

. IX , 8 HSOUBC E I,3X,1HX,8X,1HY,7X,1HZ,4X,7HWIDTH  I, 

. 23X, 2 SHE HI  SSI ON S (NICBOGP A NS/SECOND) / 

. IX, 14HNUBBER  I (KB)  , 5X , 4 H (K M)  , 4X, 3H  (B) , 4X , 6H (H)  I, 

. 6X , 2HC0,9X,2HHC,8X,3HN0X,9X,2HPT,8X,3HS02/ 

• 1 X , 96  (1 H -)  ) 

1211  FOBBAT  (16, 1X,2F9.2,2F7.1,2X,5  (1PE11.3) ) 

1222  FCBBAT  (7X,2F9. 2, F7. 1) 

200  FORBAT  (25H0WIND  INDEPENDENT  SOUBCES/1 HO) 

BETUPN 

ENTBY  DEPINF 

AT  THIS  ENTRY  ALL  WIND  DEPENDENT  SOURCES  ABE  PRINTED 
WRITE  (6,300) WS,WD 

300  FCPBAT  (1H1 , 'WIND  DEPENDENT  SOURCES  FOB',F8.4,'  BPS  WIND  SPEED  AND 

• , F8 . 4 , ' RADIANS  WIND  DIR FCTION ' ) 

IF  (I  FLAG . EQ . 0)  GO  TO  18 

IE  (N ACPI . EQ. 0 ) GO  TO  17 
WRITE  (6, ICO)  SORNAB  (3) 

DC  7 1=1 , NACPT 

7 WRITE  (6, 101)  I,  ( ACPT  (J,I)  ,J=1,4),  ( AC  PT  ( J , I ) , J=6,8)  , (ACPT(J, I)  , 

. J=1 1,15) 

17  IF (NACAB. EQ  .0)  GO  TO  18 
WRITE  (6,  110)  SORNA  B ( 3) 

DC  6 I=1,NACAR 

8 WBITE  (6,  111)1,  (ACAR  (J  ,1)  , J = 1 , 4)  , (ACAf.  (J  ,1 ) , J=6 ,10) 

18  IF  (NACIN. EQ.O)  GO  TO  19 
WRITE  (6,120)  SORNAB  (3) 

DC  9 1=1, N ACLN 

IF  (ACLN  (9,1) .NE. 1.0)  GO  TO  1987 

WRITE  (6, 1219)  I,  (ACLN  (J,I)  ,J=1,4)  , (ACLN  (J,I)  , J=13,17)  , ACLN (1  1,1) 
WRITE  (6,1229)  (ACLN (J,I)  , J=6, 8) 

1219  FORBAT  (26 , 1 X , 2F9 . 2 , 2F 7. 1 , 4X, 3HN/A , 4X , 5 ( IP  El  1 . 3)  , OPF 7 . 1 , 4X , 3H N/A) 
1229  FCRHAT(7X,2F9.2,F7.  1,  1 1X, 3H N/A) 

GC  TC  9 
1987  CONTINUE 

WRITE  (6,121)  I, (ACLN  (J,I)  , J=1,4) , ACLN (9,1),  (ACLN  (J , I)  , J=  1 3, 17) , 

. ACLN  (11,1)  , ACLN  (12,1) 

WRITE  (6,  122)  (ACLN  (J  ,1)  ,0=6,8)  , ACLN (10, 1) 

9 CONTINUE 

19  CONTINUE 
RETURN 
END 


INDIt062 
INDIP063 
INDIP064 
INDIP065 
INDIP066 
INDIP067 
INDIP068 
INDIP069 
INDIP070 
INDIP07 1 
INDIP072 
INDIP073 
INDIP074 
INDIP075 
IN  DIP076 
INDIP077 
INDIP078 
INDIP079 
INDIP080 
INDIP081 
INDIP082 
INDIP083 
INDIP084 
INDIP085 
INDIP086 
INDIP087 
'INDIP088 
INDIP089 
INDIP090 
INDIP091 
INDIP092 
INDIP093 
INDIP094 
INDIP095 
INDIP096 
IN  DIP097 
INDIP098 
INDIP099 
INDIP  100 
INDIP101 
IND IP  10  2 
INDIP103 
INDIP1 04 
INDIP105 
INDIP106 
INDIP107 
INDIP108 
INDIP109 
INDIP110 
INDIP11 1 
INDIP  112 
INDIP1 1 3 
INDIP1 14 
INDIP1 1 5 
INDIP  1 16 
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*4 


Purpose : 


Input: 


Output : 


Procedure : 


PROGRAM  MAIN 


To  read  the  general  problem  input,  set  up  the  receptor  grid, 
call  a routine  to  read  the  master  emission  file  and  then 
call  the  short-term  model . 


1 . Problem  title 

2.  Definition  of  pollutants  to  be  output 

3.  Description  of  special  cases 

4.  Description  of  receptor  grid 

5.  Description  of  statistical  receptors 


All  input  is  printed 


1.  Read  card  input 

2.  Calculate  receptor  locations 

3.  Check  statistical  receptors  against  the 
receptor  locations 

4.  Call  routine  to  read  master  emission  file 

5.  Call  the  short-term  model 


Subroutines 

Called: 


READ,  MAINS 
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AD-A046  348 


UNCLASSIFIED 


AR60NNE  NATIONAL  LAB  ILL  F/6  13/2 

AIR  QUALITY  ASSESSMENT  MODEL  FOR  AIR  FORCE  OPERATIONS  - SHORT-T— ETC CU) 
APR  77  D J BIN6AMAN 

CEEDO-TR-76-34  NL 


2 of  3 

*A046348 

a 

Q 

| 

| 

|| 

**  ir  .1.  ■ »■  .iw f r .v- • ■ - 


SET  IRSTAT 
VECTOR  TO  0 


I 


C LOOP  OVER  I = 1,  NRSTAT  J 




1 


93 


n r>  n 


HAINOOOC 

THIS  PROGRAM  IS  THE  MAIN  DRIVER  SOUTINE  WHICH  READS  IN  RECEPTOR  AND  IUIN00C1 
OTHER  GENERAL  DATA,  CALLS  SUBROUTINE  READ  TO  READ  THE  MASTER  MAIN0002 
SOURCE  EMISSION  TAPE,  AND  THE  DIRECTS  CONTROL  TO  MAINS  FOR  THE  MAIN0003 
SHORT  TERM  MODEL  MAIN0004 


REAL*8  POLNAM, XNAME 

COMMON  /AIRQAL/  RECDAT  (3,  6,312) 

COMMON  /ANNMET/  TB AR , ADD , P , PA , WSBA R, DTB AS 
COMMON  /INFO/  I RECEP , IWND IR, IT Y PE, HT AERO, SORC  ( 18) , IPOL 
COMMON  /MET/  WS, WSM PH , IWS , WD , I WD , SI NE WD ,COSEWD, JSIAB, HLID, TEMP 
. ,TEMK,UA 

COMMON  /MCNMET/  TMPAR  ,WSMBAR, A.MDMBfi, DTMBAR 

COMMON  /PERIOD/  IMONTH ,NO DAYS , IDA Y , IHR 1 , IHR2 , IFLAG, JFL AG, IONCE 
COMMON  /RCPT/  NRECEP, RECET (2, 3 12) 

COMMON  /SPEC/  NCASE,WSSP (3) ,WDSP (3) 

COMMON  /SRC  E/  N POL , NE KPT , N ENAR , NENLN, N ABPI, N ABAR , N A BLN , NACPT , 

. NACAR,NACLN,ENPT( 16,  100)  , ENAR (1 1 , 100) , ENLN  ( 1 4 , 20) , ABPT  ( 16 , 1 50)  , 
. ABAR  (11, 100)  ,A3LN(14,100) ,ACPT(16,1)  ,ACAR(11 ,24) ,ACLN  (18, 250) 
COMMON  /TITL/  POLN A M (6) ,T ITLE 1 (20) , IPCHOS (6)  , N XPOL , IP 
COMMON  /STAT/  N STA PE, NRSTA T,R STA T (2 , 20)  ,1 RSTAI  (3 1 2) 

DIMENSION  A A.  (20)  , OST  ATR  ( 2 , 20) 

READ  AND  PRINT  RECEPTOR  AND  OTHER  GENERAL  INPUT 


EAD  THE  MASTER  HAIN0002 

TO  MAINS  FOR  THE  MAIN0003 

HAINOOOU 
HAINC005 
MAIN0006 
HAIN0007 
HAIN0008 

C (18),  IPOL  HAIN0009 

WD, JSIAB, HLID, TEMP  MAIN0010 

MAIN001 1 
MAIN0012 

, I FLAG, JF LAG, IONCE  MAIN0013 

HA  I N00 1 4 
MAIN0015 

ABAR, NABLN, NACPT,  MAIN0016 

14,20) ,ABPT(16, 150) , HAIN0017 
1,24) ,ACLN(18, 250)  HAIN0018 

, N XPOL , IP  MAI  NO  01 9 

AT  (312)  MA I NO  0 20 

HAIN0021 
MAIN0022 

T MAI N00  23 

MAIN0C24 

1 READ  (5, 100) TITLE1  HAIN0025 

100  FORMAT  (20A4)  MAIN0026 

PRINT  200,  TITL E 1 NAIN0027 

20C  FORMAT  (1H1.20A4)  HAIN0028 

REAE(5,110)  N XPOL , XNAME  MAIN0029 

110  FORMAT  ( 1 6 , 5 A8)  MAIN0030 

IF  (NXFOL.EQ.O) GO  TO  31  MAIN0031 

PCLNAM  (6  ) = X N A M E MAIN0032 

31  CONTINUE  MAIN0033 

READ  (5,1 30)  (IPCHOS (I)  ,1  = 1,6)  HAIN0034 

130  FORMAT  (1016)  MAIN0035 

EC  4 C 1=1,6  NAIN0036 

IF  (IPCHOS  (I) .IF. 0)  GO  TO  41  HAIN0037 

40  CONTINUE  HAIN0038 

41  IF=I-1  MAIN0039 

FRINT  203,  (POLNAM  (IPCHOS  (I) ), 1= 1, IP)  MAIN0040 

203  FORMAT  (2 1 HO  POLL UTA NTS  SELECTED  /6A8)  MAIN0041 

READ  (5,140) NCASE,  (WDSF(I)  ,WSSP(I)  ,I=1,NCASt)  MAIN0042 

140  FORMAT  (16, 6F6.0)  MAIN0043 

IF  (NCASE)  48,48,49  MAIN0044 

48  PRINT  201  MAIN0045 

201  FORMAT  (33HONO  SPECIAL  WIND  CASES  CONSIDERED)  MAIN0046 

GO  TO  51  MAIN0047 

49  PRINT  202,  (I, V DSP (I) ,WSSP (I) ,1=1 , NCASE)  MAIN0048 

202  FORMAT  (20H0SPECIAL  WINE  CASES  /53H  CASE  WIND  DIRECTION  (DEGREESHAI NO  04 9 

.)  WINL  SPEED  (KNOTS)/ (I6,F18. 2,F23.2) ) HAIN0050 

DC  50  1=1, NCASE  MAIN0051 

WDSF  (I) =WDSP  (I) * 0.0174533  MAIN0052 

50  WS5P(I)=WSSP(I) *0. 5148  MAIN0053 

51  CONTINUE  HAIN0054 

READ  (5, 120) XBASE, YBASE,INCRX, INCRY, DELTA  MAIN0055 

120  FORMAT  (2F8. 0,218, F8.0)  MAIN0056 

PRINT  204,  XBAS E, YBASE , INCRX , I NCRY, DELT A MAIN0057 

204  FORMAT  (43HOLOKER  LEFT  CORNER  OF  RECEPTOR  GRID  IS  AT  (,F8.3,1H,,  HAIN0058 

.F8.3, 1HJ/12H  THERE  ARE,I4,12H  COLUMNS  AND,I4,23H  ROWS  WITH  A SPAHAI N0059 

.CING  OF.F6.2,11H  KILOMETERS)  HAIN0060 

NFECEF=0  HAIN006 1 


n n n 


DC  10  I*1,INCPX 
DC  10  J*1 ,1 NCRY 
NBECEF*NRECEP*1 

BICEP (1, NRECEP) = XBASE+  (T~ 1) ‘DELTA 
10  BECEF  (2 , NBECEP) =YBASE+ (J-1) *DELTA 
BEAD  (5,110) I ADD 
IF  (I ADD)  14,14,15 

14  PBINT  205 

205  FORMAT (27HONO  SPECIAL  RECEPTORS  ADDED) 

GC  TC  21 

15  PBIMT  206 

206  FOEMAT(25H0SPECIAL  RECEPTORS  ADDED  /36H  NO.  X-COORDINATE 
.OCRDINATE) 

DO  20  I=1,IADD 
READ  (5,120) XRECEP, YRECEP 
NRECEP*NRECEP+1 

PRINT  207,  NRECEP, XRECEP, YRECEP 

207  FOBMAI(I5,?14.3,F15.3) 

RECEP  (1 .NRECEP) = XRECEP 
RECEP(2, NRECEP)  =YRECEP 

20  CONTINUE 

21  CONTINOE 

READ  AND  PRINT  STATISTICAL  RECEPTOR  INPUT 

READ  130, NRSTAT, NSTAPE ,NEfc'OLD 
IF  (NRSTAT. GT.O)  GO  TC  305 
PRINT  302 

302  FORMAT  (36HONO  STATISTICAL  RECEPTORS  CONSIDERED) 

IE  (NRSIAT.LT. 0)  PRINT  303 

303  FORMAT  (30H0CAPDS  PUNCHED  FCR  SYMAP  INPUT) 

GO  TC  400 

305  PRINT  301, NRSTAT 

301  FORMAT  (1H0, 18, 22H  STATISTICAL  RECEPTORS) 

DO  310  1*1, NRECEP 
IRSTAT  (I)=0 
310  CONTINOE 

DC  340  1=1, NRSTAT 
READ  120,XSIAPP,YSTARP 
DC  320  IC=1, NRECEP 

IF  (XSTARP. EQ. RECEP (1,IC)  . AND . YSTARP . EQ . RECEP (2 , IC)  ) GOTO  330 

320  CONTINUE 

PRINT  321, XSTARP, YSTARP 

321  FORMAT  (25H0STATI3TICAL  RECEPTOR  X =,F7.3,5H,  Y =,F7.3, 

. 12H  NOT  ON  GRID) 

STOP 

330  IRSTAT  (IC)=I 

PRINT  322, I, XSTARP, YSTARP 

322  FORMAT  (112, 7H  AT  X =,F10.3,4H  Y =,F10.3) 

PSTAT  (1,I)  = XSTARP 

RST AT (2, I)  = YSTARP 

340  CCNTINOE 

IF  (NENOLD.EQ. 1)  GO  TO  400 

BEAD  (NSTAPE)  A A , IH , J PSTAT , ( (OST ATR (I , J) , 1= 1 , 2) , J= 1 , JHSTAT) , 

. JWE,NDJ,JHS,WSJ,JJJ,HLIDJ 
IF  (ORSTAT.EQ. NRSTAT)  GO  TO  350 
PRINT  341 

341  FORMAT (46H0NUMBER  OF  STATISTICAL  RECEPTORS  ON  OLD  TAPE  ( , 1 2 , 

. 42H) , DO  NOT  AGREE  WITH  NUMBER  FOR  THIS  RUN  (,I2,1H)) 

STOP 

350  DC  360  J=1, NRSTAT 
DC  360  1*1,2 


BAT  N0052 
BA  I NO  06  3 
MAIN0064 
NAIN006S 
MAI  NO 066 
BA  I NO  067 
MAIN0068 
MAI  NO 06 9 
MAIN0070 
NAIN0071 
N AIN0072 
Y-CMAINC073 
NAIN0074 
MAIN0075 
MAI N0076 
MAIN0077 
MAIN0078 
MAIN0079 
MAI N0080 
MA I NO  08  1 
MAIN0082 
MAIN0083 
MAI N0084 
M A I NO  08  5 
MAIN0086 
MAIN0087 
MAI N0088 
MAIN0089 
MAINC090 
MAIN0091 
MAIN0092 
MAIN0093 
MAIN0094 
MAI N0095 
MATN0096 
MAIN0097 
MAIN0098 
MAI N0099 
MAINO  100 
MAIN0101 
MAINO  102 
MAINO  103 
MAIN0104 
MAIN0105 
MAI  NO  1 06 
MAINO  107 
MAI  NO  108 
MAI  NO  1 09 
MA I NO  1 1 0 
MAIN0111 
MAINO  112 
MAI  N0 1 1 3 
MAINO  114 
MAINC1 15 
MAIN01 16 
M A I NO  1 1 7 
MAI  NO  1 18 
HAIN0119 
MAI NC 120 
MAI  NO  12  1 
MAINO  122 
MAIN 0123 
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non 


IF  (CSTA1P  (I,J)  .EQ.RSIAT(I.J) ) GOTO  360 
PH  hi  351, ( (OSTATR  ( I, J) ,1  = 1,2)  ,J=1,NBSTAT) 

351  FORMAT  (64 HO  ST ATISTICA I PECEPTOB  LOCATIONS  DO  NOT  MATCH, THOSE  ON  TA 
• FE  ARE  , 20 (/2F15. 3)  ) 

STOF 

360  CONTINUE 

POSITION  OLD  TAPE  AT  END  OF  LAST  RECORD 

370  READ  (NSTAPE,END=380) 

GO  TO  37C 

380  BACKSPACE  N ST APE 
BACKSPACE  NSTAPE 

400  CONTINUE 
CALL  READ 
CALL  MAINS 
STOP 
RETURN 
END 


HA  I NO  124 
MAT  NO  125 
HA  I N0 1 26 
HAIN0127 
MAI  NO  128 
HATN0129 
MAI  N0 1 30 
HAIN01 31 
MAI  NO  132 
HAIN0133 
HAINC 134 
MAI  NO  1 35 
MAINO  136 
MAI  N0 1 37 
MAINO 138 
MAI  NO  1 39 
MAINO 140 
MAI  NO  14  1 
MAINO  142 


JIILIIIJUIUUPJP 


T 
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. 

Purpose; 


Input: 


I 

Output: 


Procedure : 


Subroutines 

Called: 


•••  -vyjwBivw 


SUBROUTINE  MAINS 


To  direct  the  short  term  calculation  by  reading  the  data,  check- 
ing for  special  cases  and  calling  the  source  and  diffusion 
calculation  routines. 


1.  Card  input  to  describe  the  time  periods  to  be  calculated 

2.  Card  input  to  describe  the  meteorological  conditions 

3.  Special  case  data  from  the  MAIN  routine 

1.  Common  block  data  to  be  used  by  the  calculation  and  output 
subroutines 

2.  Statistical  receptor  data  on  tape  and/or  cards  for  SYMAP 

1.  Set  constants 

2.  Read  general  data 

3.  For  each  period: 

a.  Read  time  and  meteorological  data 

b.  Check  for  near  zero  wind  speed 

c.  Check  limits  of  mixing  depth 

d.  For  each  hour: 

1.  Find  the  critical  distance 

2.  Set  wind  direction  and  speed  classes 

3.  Call  the  non-aircraft  source  routines 

4.  Check  for  special  cases  of  wind  speed 
and  direction 

5.  Call  the  aircraft  source  routines 

6.  Call  the  diffusion  model  and  output 
routines 

7.  Check  for  statistical  output,  including 
cards  for  SYMAP. 


SOURCE,  INDINP,  ACSRCE,  DEPINP,  POLSOR,  OUTPUT 


Function 

Called: 


SIGCZ 
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SUBROUTINE  MAINS 


7 


99 


H •’•"•“••I— 
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WA 


SUBROUTINE  BAINS 

THIS  ROUTINE  IS  THE  BAIN  DRIVER  FOR  THE  SHORT  TERB  BODtL 
COBHON  /AIRQAL/  RECDAT(3,  6,312) 

CCBBON  /BET/  KS,WSMPH  ,IWS , WD , T WD , SI NEWD,COS EHD , JST Ab, HLID, TE BF, 
. TEBK 

COBHON  /PFRIOD/  IHONTH , NODAYS , I DA Y ,IHR 1 , IHR2 , IF  LAG 
CCHBCN  /XTRAN/  XL , WSHD,TY , TZ 
COBHON  /HONHEI/  THBAR  , WSMBAR , A HD MBR , D I MBA R 
CCHBCN  /SPEC/  NCASE,WSSP (3) ,WDSP(3) 

COBHON  /WDUN/  HSAVE 

CCHBCN  /RCPT/  NRECEP, EECEP (2, 312) 

COBHON  /STA 1/  NSTA P E, NRSTAT, R STA T (2 , 20) , I RS I AT ( 3 1 2) 

COHHCN  /TITL/  PCLN AM ( 6)  ,T ITLE 1 (20) , IPCHOS  (6 ) , N XPOL 
DIHENSION  KRH  (100)  , JS  TABB  (ICO)  , WSS  ( 1 00)  , HDD  ( 1 00)  ,TEHPP(1CC)  , 

. HLIEE(IOO)  , HSCLAS  ( 5) 

DIHENSION  WEEK  (2) 

DATA  WEEK  / 3HDAY,  3H  END  / 

DATA  H SC LAS/1. 8018, 3. 3462,5.4055,8.4943,10.8110/ 

EATA  PI, SHLID  /3.  14  15927, 3048./ 

I FLAG  = 1 
WSL  = 1./2.237 

READ  100,  IHONTH, NODAYS, NPER, THBAR 
100  FCRHAT  (316 ,F6. 0) 

PRINT  203, IHONTH, NOD AYS, THBAR , NPER 


HAINS000 
HAINS001 
HAINS002 
HAI NS003 
HAI NS004 
HAINS005 
MAI NS006 
HAINS007 
HAINS008 
H AINS009 
MAI NS01 0 
MAINSO  1 1 
MAINS012 
MAINSO  1 3 
HA  I NS  0 1 4 
M A I N SO  1 5 
MAINS016 
MAINS017 
MAINS01  B 
MAINS019 
MAI NS020 
MAINS02  1 
MATNS022 
MAINS023 
MAINS024 
MAINS025 


203  FCRHAT  (11  HO  FOR  HONTHI3.11H,  THERE  AR  EI4, 3b  H DAYS  WIIH  AN  AVERAGE  MAINS026 


.TEMPERATURE  OFF6. 2, 4H  (F)  / 

. 1 5 , 2 7H  PERIODS  HILL  EE  CONSIDERED) 

FOR  EVERY  PERIOD,  READ  THE  HOURLY  H ET  DATA 

DC  50  IPER=1,NPER 
READ  100,  NHOU  R , ID A Y 

PRINT  201,  IPEP , NPER, NHOUP, WEEK (IDAY) 


M AINS027 
HAINS028 
MA I NS  029 
MAINS030 
HAINS031 
MAINS032 
M A I N SO  3 3 
MAINS034 


201  FCRHAI  (1H1 , 29HI NFORH ATION  FOR  PERIOD  NUMBER, 13, 3H  OF,  13, 8H  PER IODH AI N SO 35 

.S  / 5X , 1 3, 33H  HOURS  IN  THIS  PERIOD,  FOR  A WEEK, A3  ) HAINS036 

READ  101,  (KRH  (I) , JSTABB(I) ,WSS (I) ,WDD(I)  ,TEHPP  (I)  ,HLIDD  (I) , MAINS037 

-1=1 , NHOUR)  MAINS038 

101  FORMAT  (21 6, 4F6 .0)  MAINS039 

PRINT  202  , (I  , NHOUR,  KRH  (I)  , JST  ABB  ( I)  , WSS  (I)  , HDD  (I)  , TEH  PP  (I)  , MATNS04  0 

. HLIDD(I) ,1=1, NHOUR)  MAINS041 

202  FORMAT  (1H0, 8HFOR  HOUR, 15, 3H  OF,I5,6H  HOURS  /5X,  10HHOUR  INDEX  , MATNS042 

. 13  / 5X,  1 8HSTABILITY  CATEGORY  , 12  / 5X,  26HHIND  SPEED  (HETERS/MA I NS04 3 

•SECOND)  , F8.2  / 5X,  24HWIND  DIRECTION  (DEGREES)  , F8.2  / HAINS044 

. 5X  , 1 5HTEM  PE  R ATURE  (F)  , F8.  2 / 5X,  21HMIXING  DEPTH  (METERS)  , MAINS045 
. F 8.2  ) MAINS046 

MAINS047 

CHECK  WIND  SPEED  AND  LID  HEIGHT  MAINS04S 

HAINS049 

DC  20  IH=1, NHOUR  MAINS050 

IF  (WSS  (IH)  .GE.  WSL)  GO  TO  18  HAINS051 

MAI NS052 

REHCVE  ZERO  WIND  SPEED  CLASSES  MAINS053 

HAINS054 

IF  (NHCUR  .EQ.  1)  GO  TO  16  HAINS055 

WSS  (IH)  = WSL  HAINS056 

IF  (IH  .EQ.  NHOUR)  GO  TO  17  MAINS057 

IF  (HSS  (IH+ 1)  .LT.  WSL)  GO  TO  14  MAINS058 

HDD  (IH)  = WDD(IH+1)  HAINS059 

GO  TC  18  MAINS060 

14  IF  (IH  .NE.  1)  GO  TO  17  HAINS061 


102 
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DC  15  J H = 2 , NHCU  R 

IF  (HSS(JH)  .LI.  WSL)  GO  TO  15 

HDD  (IH) = HDD  (OH) 

GC  TO  1b 
15  CONTINUE 
16  PRINT  200 
STOP 

200  FORMAT  (1H1,10X,' WINDS  PEED  IS  TOO  SMALL') 

17  HDD  (IH)  = HDD  (IH-  1) 

SET  INFINITE  LID  HEIGHT  AT  3048  METEBS 

18  IE  (HLIDD  (IH) .GT.  3048.)  HLIDD(IH)  = SHLID 
IF  ( HLIDD  ( I H)  .GE.  30.5)  GO  TO  19 

GROUND  LEVEL  INVERSION,  ASSUME  INFINITE  LID  HITH  A STABILTY  OF  5 

HLIDD  (IH)  = 3048. 

JSTABB  (IH)  = 5 

19  SHLID  = HLIDD  (IH) 

20  CONTINUE 

BEGIN  HCUELY  CALCULATIONS 

DO  3C  IHOUR  = 1.NHOUR 
IHR1  = KRH(IHOUB) 

HS  = NSS(IHOUF) 

IHP2  = IH  PI 

HD  = KDD(IHOUR) *9.0 174533 
TEMF  = lEMPP(IHOUR) 

TEMK  = (TEMF-32 . ) / 1 . 8 ♦ 273. 

JSTAB  = JSTABB (IHOUR) 

HUD  = HLIDD  (IHOUR) 

WSMPH  = HS  ♦ 2.237 
SINEHD  = SI N (HD) 

COSE  HD  = COS  (HD) 

HL  = 0 . 47*HLI D 
WSAVE=kS 

IF (HL.LT. 1. 0) HL  - 1. 0 

FIND  CBIIICAL  DISTANCE,  XL,  IN  KILOMETERS 
XI=SIGCZ(JSTAE,HL)/100U. 

FIND  HIND  DIRECTION  AND  SPEED  CLASSES 
DC  21  K= 1 , 1 6 

IF  (HD  .GT.  (22.5*K-11.25)*PI/180.)  GO  TO  21 
IHD  = K 
GC  TO  22 

21  CONTINUE 
I HD=  1 

22  DC  23  K= 1 , 5 

IF  (HS.GT.HSCLAS(K) ) GO  TO  23 
I HS  = K 
GC  TO  25 

23  CONTINUE 
I HS  = 6 

25  CONTINUE 

PRINT  925, IHOUR 
925  FORMAT  (9H1FOF  HOURI3) 
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CALI  THE  NCN- AIRCRAFT  SOURCE  ROUTINES  AND  PRINT  THE 
HIND  INDEPENDENT  INPUT 

CALL  SOURCE 
CALL  INDINP 
IVDT  = IHD 

IF  (NCASE  . EQ.  0)  GO  TO  26 

DC  26  1=1, NCASE 

COMP  = HS  * COS  (HD  - WDSP(I)) 

IF  (COMP  .LI.  WSSP ( I) ) GO  TO  26 
IHD  =17+1 
GO  TO  28 
26  CCNTINUE 
28  CCNTINUE 

CALL  THE  AIRCRAFT  SOURCE  ROUTINES  AND  PRINT  THE 
HIND  DEPENDENT  INPUT 

CALL  ACSRCE 
CALL  CEPINP 
IHD  = I HDT 

IF  STATISICAL  OPTION  IS  CHOSEN,  WRITE  FIRST  RECORD  ON  NSTAPE 

IF  (NRSTAT.LE.O)  GO  TO  300 
NHR=  1 

WRITE  (NSTAPE)  TITL E 1 , IHR 1 , NR STAT , ( ( R STAT (I , J)  ,1=1,2)  ,J=1,NRSTAT) 
. IHD,KD,IWS  ,WS, JSTAfi, HLID, NHR 

300  CCNTINUE 

CALL  THE  DIFFUSION  MODEL 
CALL  PCLSOR 

IF  (NFSTAT. EQ.O)  GO  TO  320 
DC  310  K = l,  3 
PUNCH  301 , NRECEP, K 

301  FORMAT (216) 

DC  310  N=1, NRECEP 

PUNCH  302,  (RECEP  (I,N)  ,1=1,2)  , (RECDAT  ( K,  J , N)  , J=  1,6) 

302  FCRMAT (1P8E10.  3) 

310  CCNTINUE 

320  CONTINOE 

PRINT  RESULTS 
CALL  OUTPUT 

IF  THE  STATISTICAL  OPTION  IS  CHOSEN,  RECORD  THE  OUTPUT 

1.  (NRSTAT. EQ.O)  GO  TC  360 
K = « 

PU«CH  301, NRECEP, K 
DO  330  N=1, NRECEP 

PUNCH  302, (RECEP (I, N)  ,1=1,2) , ( RECDA T ( 1 , J , N)  ,J=1,6) 

330  CCNTINUE 

IF  (NRSTAT.LT.O)  GO  TO  360 
K = 0 

DC  350  N=1, NRECEP 
IF  (IRSTAT(N) .LE.O)  GO  TO  350 
K = K+  1 

DO  340  J= 1 , 6 

RECDAT  (1,J,K)  =R  ECDAT ( 1 , J , K) 
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Purpose: 


Input: 


Output: 


SUBROUTINE  METHA 


To  calculate  diurnal  emissions  allowing  each  source  in  a class 
to  have  a unique  or  default  distribution  pattern. 


1.  The  ICLASS  number  of  the  sources  and  NPTC,  the  number  of 
sources  not  using  the  default  of  a uniform  distribution. 

2.  For  each  of  the  NPTC  sources,  the  source  ID  number  and  frac- 
tions of  the  hour,  day  and  month,  FH,  FD  and  FM,  which  that 
source  is  on.  If  one  or  two  of  the  fractions  are  left  blank, 
the  default  is  used.  If  all  are  blank,  the  source  is  assumed 
to  be  off. 


The  Array  specified  in  the  calling  sequence  to  the  subroutine  is 
filled  with  the  computed  emission  data. 


Subroutines 

Called: 


CLASSE 
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SUBROUTINE  METHA 


SET  LSRCE  AND 
NSRCE  LIMITS 
SII>=0 
ICOLNT*0 


SUBROUTINE  METHA  (Contd.) 


FILL  ARRAY  WITH 
PROPER  GEOMETRY 
DATA  FOR  SOURCE  N 


CN  SOURCES 


RETURN 


n n n nor  o nnn 


E252 . . 2 


SUBROUTINE  METH  A (M AXN , ASP AY , 1 1 , 1 2 , ICL) 

C 

C This  BCUTJNE  CALCULATES  DIURNAL  EMISSIONS  ALLOWING  EACH 

C SOURCE  IN  A CLASS  TO  HAVE  A DIFFERENT  DISTRIBUTION  PATTERN. 

C DEFAULTS  ARE:  FH  = 1/24 

C FD  = 1/7 

C FM  = 1/12  OR  1 

C 

COMMON  /PER IOL/  IMON T H ,NOD AYS , IDA Y, IH R 1 , IHR2 ,1  FLAG ,J FLAG 
COMMON  / S P C E/  NPLTS ,NENPT,NENAR, NENLN, N ABPT, N ABAR , N ABLN , 

. NACPT,NACAR,N.'  7.N,  ERF!  (16,100)  ,ENAR  (1  1 ,100)  ,ENLN  (14 , 20)  , 

. ABET(16,150) , ABAR(11,100)  , ABLN  (14,100) 

COMMON /JUNK /DA  SRC E , NS ECE, SORCE ( 1 7, 300) , SORGM (10,200) 

. , LCC  1, LOC2 , NG  JC*  , PT 
DIMENSION  ARS hi  '"1,12) 

LSRCE=NSRCE+1 

NSRCE=NSRCE+MAXN 

SID=C. 

ICOUNT=0 

IF  (JFLAG.EC.O)  GO  TO  5 

NPTC=0 

GO  1C  6 

5 REAL  1, ICL ASS, N PTC 

1 FORMAT  (214) 

IF  (ICLASS. NE. ICL)  CALLCLASSE  (ICL,ICLASS) 

6 DO  IOC  N=LSRCF,NSRCE 

IE  ( N ETC. EQ • 0)  GO  TO  30 
IF  (SID-SCRCE  (1,N) ) 10,40,30 
1C  ICOUNT  = ICOUNI+ 1 

IF  (ICCUNT.GT. NPTC)  GO  TO  30 
RIAL  2, SID, FH,FD,FM 

2 FORMAT  (F4.0,4X, 3F8.7) 

IF  (FH+FD+FM. EQ.0.0)  GO  TO  20 

DETERMINE  DEFAULT  VALUES 

IF  (FM.NE.0.0)  GO  TO  15 
F M= 1 ./ 1 2 . 

IF  (DAYS. GE. 365.)  FM=1. 

15  IF  (FC.EQ.0.0)  FD=1./7. 

IF  (FH.tQ.0.0)  FH= 1 ./ 24 . 

20  CONTINUE 

IF  (SID-SCRCE (1 ,N) ) 30 ,40, 3C 

UNIFORM  DISTRIBUTION 

30  FRC=1.CE+6/(24.*3.6*365.) 

GO  TC  50 

NCN-UNIFORM  DISTRIBUTION 

40  F EC  = FM*F  D*F  K*  (7 . /DA YS ) * ( 1 . 0E+ 6/3 . 6) 

5C  DC  60  1=1, NPLTS 

ARRAY  (I  + LOC 1, N) =SORCF (I  + LOC2, N)  *FRC 
60  CONTINUE 

IF  (NGECM. EC.C)  GO  TO  100 
DC  70  1=1, NGFOM 
ARRAY  (I , N)  = SGFC3  (I  ♦ 2 , N) 

70  CONTINUE 

IF  (IET.E0.1)  ARRAY  (10, N) =SORCE(2,N) 

ICO  CONTINUE 
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SUBROUTINE  METHB 


Purpose : 


To  calculate  diurnal  emissions  using  a degree-hour  method. 


Input : 

The  ICLASS  number  o£  the  sources  and  UNIFRC,  the  fraction  of 
emissions  which  are  to  be  uniformly  distributed. 

Output: 

The  array  specified  in  the  calling  sequence  to  the  subroutine 
is  filled  with  the  computed  emission  data. 


Subroutines 

Called: 


CLASSE 


n r 


{ 


c 

C 


c 


JUFFGU7INE  METHB (« AXN  , ARR  AY,  1 1 ,I2,ICL) 

Hlli  ROUTINE  CALCULATES  DIURNAL  EMISSIONS  USING 
A DEGREE-HOUR  METHOD 

CCMMCN  /PERIOD/  IMONT H , NODAY S , IDA Y, IHR 1 , IHR2 , IFLAG , JFLAG 
COMMON  /SRC E/  N PLTS , N E NPT , NEN A R, N ENLN, N ABPT , N ABAB , N ABLN , 

. NACPT,NACAH,NACLN, ENFT (16,100)  , E NAR (1 1 , 1 00 ) , ENLN ( 1 4 , 20)  , 

ABPT (16, 150) , ABAR (11,100) , ABLN  (14,100) 
COMMON /JUNK/ DA YS,LSRCE,NSFCE,SORCE(17, 30 0) ,SORGM (10,200) 

. , LOC 1 , LOC2 , NGEOM , IPT 

CCMMCN/MET/ViS,  USMPH  , IKS  , V D,  IN  D,SINKD,  COSWD, 

. JSIAE, HLIC, TEMF, TFMK 
DIMENSION  AFRAY  (11,12) 

CCMMCN  /ANNMET/  TB AR , A DD, P , PA , WSB AR, DTBAR 

I SRCE=NSPCE+ 1 

NSRLE=NSRCE+MAXN 

TMP=TEMF 

IF  (1EMF.GT.65. ) TMP=65. 

IF  (JFLAG. EC. 0)  GO  TO  5 
U NI F FC=  . 1 0 
GC  TO  6 

5 READ  1,1 CLASS, UNIFRC 
1 FORMAT  (I4,UX,F8.7) 

IF  (ICLASS.N  E. 1CL)  CALL  CLASSE  (ICL.ICLASS) 

6 FRC=  ( ( (1 .0- UNIFRC) * ( (65. O-THP) / (ADD*24 . 0) ) ) + (UN I FRC/ ( 24 . 0* 

* ( 1 . OE+6/3. 6) 

CC  30  N=LSRCE , NSRCE 
DC  10  1= 1 , N FLTS 

APR  AY (I  + LOC 1 , N) =SORCE  (I  + LOC2, N) ♦FRC 
10  CONTINUE 

IF  (NGECM. EC. 0)  GO  TO  30 

DC  20  1=1, NGEOM 

ARRAY  (I, N) =SOFCE(I  + 2, N) 

20  CONTINUE 
30  CONTINUE 
RETURN 
END 
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J SUBROUTINE  NETHC 

Purpose: 

To  calculate  diurnal  emissions  using  the  same  distribution 
pattern  for  all  sources  in  the  class. 

Input: 

The  ICLASS  number  of  the  sources  and  the  fractions  of  the  hour, 
day  and  month,  FH,  FD  and  FM,  which  the  sources  are  on.  If 
one  or  two  of  the  fractions  are  left  blank,  the  default  is  used. 

If  all  are  blank,  the  sources  are  assumed  to  be  off. 

•• 

Output: 

The  array  specified  in  the  calling  sequence  to  the  subroutine 
is  filled  with  the  computed  emission  data. 

Subroutines 

Called: 

CLASSE 


U U <J 


c 

c 

c 

c 

c 

c 

c 


c 


SUBROUTINE  HETHC  (MAX N, ARRAY, II, 12, ICL) 

THIS  ROUTINE  CALCULATES  DIURNAL  EMISSIONS  USING  THE  SAME 
DISTRIBUTION  PATTERN  FOR  ALL  SOURCES  IN  A CLASS. 

DEFAULTS  ARE:  FH  = 0 CR  1/12  OR  1/24 
FD  = 1/7 
FM  = 1/12  OR  1 

COMMON  /SRCE/  N PLTS , N ENPT , NENA R , NENLN , N AB PT , N AB A R , N ABLN , 

. NACFT,NACAR,NACLN, EN FT (16, 100)  , EN AR ( 1 1 , 100)  , ENLN  (14,20), 

. ABPT(16,150)  ,ABAR(11,100)  , ABLN  ( 1 4 , 100) 

CCHMC  N/J  UNK/D A Y S ,LSRC  E , NSRCE, SORCE ( 1 7 , 300) , SORGM (10,^00) 

. ,LOC1 ,LOC2,NGECH, IPT 

COMMON  /PERIOD/  IMONTH ,NOD AYS , ID A Y , I HR1 , IHP2 ,IFL AG , J F L AG 
DIMENSION  ARRAY  (II ,12) 

LSRCE=NSFCE*1 
NSRCE=NSRCE+NAXN 
IF  (JFLAG.EQ.C)  GO  TO  6 
FD=1./7. 

FH=0 . 0 
FH=0 . 0 
GC  TC  6 

5 READ  1,ICLASS,FH,FD,FH 
1 FCRMAT(I4,4X,3F8.7) 

IF  (ICLASS.NE.ICL)  CALLCLASSE  (ICL,ICLASS) 

IF  (FH+FD+FM.EQ.0.0)  GO  TO  10 

DETERMINE  DEFAULT  VALUES 

IF  (FD.EQ.0.0)  FD=1./7. 

6 IF  (FH.NE.0.0)  GO  TO  7 
FH=1 ./12. 

IF  (CAYS. GE. 365.)  FM=1. 

7 IF  (FH.NE.0.0)  GC  TC  10 

IF (IH81.GT. 6. AND. I HR1.LT.  19.  AND. IHR2.GT. 6. AND.IHR2.LT.  19) F 
IF  (IHR1.EQ. 1.AND. IHR  2 . EQ.24)  FH=1./24. 

10  FRC=FH*FD*FH*  (7 . /D AYS ) * ( 1 . OE  + 6/3 . 6) 

20  DC  ICO  N=LSRCE, NSRCE 
DO  30  1= 1 , NFLTS 

ARRAY ( I+LOC 1 , N) =SORCE (I+LOC2, N) *FRC 
30  CONTINUE 

IF  (NGEOH.EQ.O)  GO  TO  100 

DC  40  I=1,NGEGH 

ARRAY (I, N) = SORCE (1+2, N) 

40  CCNTINUF 

IF  (IFI.EQ.1)  ARRAY (10, N) =SORCE(2,N) 

100  CONTINUE 
RETURN 
END 
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SUBROUTINE  I^THD 


Purpose: 

To  calculate  diurnal  emissions  using  the  temporal  distribution 
arrays  for  fuel  handling  activities. 

Input: 

None 


Output: 

The  array  specified  in  the  calling  sequence  to  the  subroutine 
is  filled  with  the  computed  emission  data. 


Subroutines 

Called: 

None 


iri  Chilli  I'.nriniWii, 


U7 


o n n n 


c 


SUEFCUTINE  MET  HD  (H  AXN  , AFtR  A Y , 1 1 , 12) 

THIS  ROUTINE  CALCULATES  DIURNAL  EMISSIONS  USING  THE 
TEMPORAL  DISTE IBUTION  ARRAYS  FOR  FUEL  HANDLING  ACTIVITIES 

CCBMCN  /SRCE/  N PLTS , N E NPT , NEN AR, N ENLN , N ABPT , N ABAP , N A BLN , 

. NACPT,NACAS,NACLN, ENFT (16,100)  , EHAB ( 1 1 , 100)  , ENLN  (14,20) , 

ABPT  (1b, 150) , ABAR (11,  100)  , ABLN  (14,  100) 
COHHCN/JUNK/DA Y 5,LSRCE,NSPCE,SORCE(17,300) , SORGM  ( 1 0 , 2 00) 

. ,LCC1,LCC2,NGECM,IFT 
CCMMCN/FEFIOD/I MONTH, NOE AYS,  ID  AY,  IHR1,  IHP2 
COMMCN/MET/WS,WSNPH,IWS,WE,IWD,SINWD,COSND, 

. JSTA.E,HLID,TEMF,TEMK 

CCMMON  / DEFALT  / ITAPE , ACLND Y, ACLNDZ, ALPH A (7 ) , BET A ( 7)  , ELBE  NS (7) 
CCBMCN  /DSTRET/  ACBO ( 1 3, 8 ) , ACDY (2, 8)  , ACHR (24, 6) , V HBLMO ( 13)  , 

. VHMLDY  (2) , UHMLHR (24)  ,CVA6MO(  13)  , CVAbDY  (2) , CVABHR (24)  .CVENMO  (13)  , 
. CVENDY  (2)  ,CVENHR  (24)  ,FLMO(13,7)  , FLOY  (2,7)  ,FLHR(24,7)  ,NC1 
CCBMCN/ BONNET/  TMBAP 
DIMENSION  ARRAY  (11,12) 

L£RCE=  NSRCEi- 1 
NSRCE=NSRCE+MAXN 
Nhl =IH  R2 

IF (IHR1.GT. IHR2)  NHI=24+IHR2 
HRS=NHI-IHR1  + 1 
DC  30  N=LSRCE , NSRC  E 
FLHOU  F = 0 . 

IDF=SCRCE(14,N) 

DC  1C  I = IHR1  ,NHI 
II=I 

IE  (I.GT.24)  11  = 1-24 

FLHOUR  = FLHR  (II, IDF)  +FLHOUR 
10  CCNTINUE 

FLHCUR=FLHCUR/HRS 

TVP=  EXP (ALPHA (IDF)  -BETA (IDF)  / (5 . * (THb AR-32 . ) /9 . *27 3. ) ) 
BRLCSS=SOFCE  (13  ,N)  * (TVP/ ( 14. 7-TVP) ) **0.69 
K PKLCS  = SC  PCE  (12, N) *TVE 

FRC  = FLMO(IHONTH,IDF) *FLDY  (IDA  Y , IDF) *F  LHOUR*  (7. /DAYS) 

APRAY  (12, N)  "(BRLOSS/(365.*24.)  + K R KLOS*F  PC)  *1.E  + b/3.b 
IF  (I  FT.  EC.  1)  ARRAY  (10,N)=SCFCE(2,N) 

IF  (NGEOM.EQ.O)  GO  TO  30 

DC  2C  1=1, NGEOM 

ARRAY  (I , N) = SCFCE  (1  + 2, N) 

20  CCNTINUE 
30  CCNTINUE 
RETURN 
END 
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SUBROUTINE  METHE 


To  calculate  diurnal  emissions  using  the  temporal  distribution 
arrays  for  vehicle  activities. 


The  array  specified  in  the  calling  sequence  to  the  subroutine 
is  filled  with  the  computed  emission  data. 


Subroutines 

Called: 


I 


SUBROUTINE  METHE 


BEGIN  LOOP  OVER  N 
SOURCES 


I 


MJLTIPLY  ALL  POLLUTANT 
EMISSIONS  FOR  SOURCE  N 
BY  FRC  AND  STORE 
RESULTS  IN  ARRAY 


FILL  ARRAY  WITH 
PROPER  GEOMETRY 
DATA  FOR  SOURCE  N 


END  LOOP  ON  SOURCE  1*— 


RETURN 


3 
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SUBROUTINE  METHE  (MAXN  .ARRAY, ARNO, AFDY , ARHR, 1 1 , 1 2) 

THIS  ROUTINE  CALCULATES  DIURNAL  EMISSIONS  USING  IHL 
TEMPORAL  DISTRIBUTION  ARRAYS  FOR  VEHICLE  ACTIVITES 

CCnnCN  /SRCE/  NPLTS,NENPT,NENAR,NENLN,NABPT,NABAR,NABLN, 

. NACFT,NACAR,NACLN,ENPT(16,100)  , E NAR ( 1 1 , 1 00 ) , ENLN  (14,20)  , 
. ABPT  (16, 150) , ABAR ( 11, 100)  , ABLN  (14,  100) 

COMMCN/JUNK/DAYS,LSRCE,NSRCF,SORCE(17,300)  , SORGfl ( 1 0 ,2 00) 

. , ICC  1 ,10C2 , NGECM,  I PT 
CCMHCN/FEPIOD/I MONTH, NODAYS, ID AY,  IHR1,  IHR2 
DIMENSION  ARNO (13)  , AR DY (2)  , AR HR  ( 24)  , A R RA Y (1 1 , 12) 

LSRCE=  NSRCE+ 1 
NSRCE=NSRCE+MAXN 
A FHCUF=0 . 

NHI=IHR2  . 

IF(IHR1.GT. IHP2)  N H 1= 24+IHR2 
H RS=  NHI-IH  R1  + 1 
DC  1C  I=IHR 1 , NHI 
II=I 

IE (I.GT.24)  11=1-24 

AEHCUR=ABHOUR+ARHR (II) 

10  CCNTINUE 

ARHOUR=ARHOOR/HRS 

FRC  = A RMO  (IMONTH) ♦ARCY  ( IDA Y) * AR HOU F* ( 7 . /DAYS ) * (1E+6/3.6) 

DC  40  N=LSRC£, NSRCE 
DO  2C  1 = 1 , N PLT S 

ARRAY  (I  + LOC  1,N)  =SORC1'  (I+LOC2.N)  *FRC 
20  CCNTINUE 

IF  (NGEOM.EQ.C)  GO  TO  40 
DC  30  1=1, NGEOM 
30  ARRAY (I, N) =SORCE (I ♦2, N) 

40  CCNTINUE 
RETURN 
END 


METHEOOO 
MET  HFCO  1 
METHE0C2 
METHE003 
METHE004 
ME1HE005 
METHEG06 
ME  THE  007 
METHE008 
METHE099 
KETHE010 
MFTHEO  1 1 
METHE012 
METHE01 3 
MET  HEO  1 4 
METHEO  1 5 
METHEO 16 
ME  THE 0 1 7 
MFTHE019 
METHF019 
ME  THE  020 
MET  HEO  2 1 
METHFC22 
METHEC23 
ME  THE  02  4 
METHE025 
METHE026 
ME  THE02'7 
METHE028 
METHEC24 
METHEO  30 
METHEO 3 1 
METHEO  32 
METHEO  3 3 
ME  THE  0 34 
METHEO  35 
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o n n n o 


SUBROUTINE  OUTPUT 


V1*  W 1W  WffW 

_1LL 


^Flrx^sW.  35 : 'jksjd 


■ TT"T 


I 


i 


I 


THIS  ROUTINE  PRUTS  THE  POLLUTANT  CONCENTRATION  AT  ALL 
RECEPTORS  FOR  THE  ENVIRON*  AIRBASE,  AIRCRAFT  AND  TOTAL 
CCHBI NED  SOURCES. 

REAL*8  POLNAH 
REALMS  SORN AH  (4) 

COHBCN  /AIRQAL/  RECDAT  (3,  6,312) 

COHHON  /PERIOD/  IHONTH, NODAIS , IDAY, IHR 1 , IHR2 
COHHCN  /RCPT/  NRECEP, RECEP  (2, 312) 

COHHON  /TITi/  POLNAH ( 6) ,TITLE1 (20)  , I PCHOS ( 6),NXP0L,NP 
DIHENSION  NNH ( 1 3)  ,NNHR(25)  ,NND(2) 

DATA  SORN AH/7HENFI RON , 7H AIRPORT, 8HAIRCRAFT, 5HTOTAL  / 

DATA  NNHR/4H0000,4H0 100, 4H0200, 4H0300 , 4H0400,4H0500,4H0600, 

. 4H0700, 4H0800, 4H0900, 4H1000,4H1100,4H1200,4H1300,4H1400,4H1500, 

. 4H1600,4H1700,4H1600,  4H1900, 4 H2000, 4 H2 100 , 4H2200 , 4H23 00, 4H24 00/, 
. NND  /4HDAY  , 4H END  /, 

. NNH/4HJ AN  , 4HFEB  , 4HHAR  ,4HAPR  , 4HMAY  ,4HJ0N  .4HJUL  , 

. 4HAUG  , 4HSEP  ,4HOCT  ,4HNOV  ,4HDEC  , 4H YEAR/ 

DO  100  ITYPE*1,3 
IS»1 

IS1=HIN0 (S, NP) 

110  LNCT*37 

DO  120  IRECEP*1 .NRECEP 
IF  (LNCT.LT.37)  GO  TO  121 

WRITE  (6,220) TITLE  1, NNH (IHONTH) , NNHR (I HR  1)  , N N HR (IHR2+1) , NND (IDAY) 
WRITE (6,200) SORNAH  (ITYPE) , (POLNAH (IPCHOS (J) ) ,J=IS,IS1) 

WRITE  (6,260) 

LNCT=  1 

121  WRITE (6,210) IRECEP, (RECEP ( J, I RECEP)  , J= 1 , 2) , 

. (RECDAT (ITYPE, IPCHOS (K  ), IRECEP), K = IS,IS1) 

LNCT=LNCT*1 

IF  (HOC  (IRECEP, 3) . EQ. 0) WRITE (6, 260) 

120  CONTINUE 

IF  (IS1.EQ.NP)  GO  TO  100 
IS*IS1*1 
IS1=NP 
GC  TO  110 
100  CONTINUE 
IS=1 

IS1 *HIN0 (5, NP) 

125  LNCI=37 

DO  130  IRECEP-1, NRECEP 
IF  (LNCT.LT.37)  GO  TO  133 

WRITE (6,220) TITLE1 , NNH (IHONTH)  , NNHR (I HR  1)  , NNHR (IHR2+1) , NND  (IDAY) 
WRITE (6,200) SORNAH  ( 4 ), (POLNAH  (IPCHOS  (J) ) ,J  = IS, IS  1) 

WRITE  (6,260) 

LNCI=1 

133  CCNTINUE 

DO  131  J*IS,IS1 
DO  131  K=2, 3 

131  RECDAT(1, IPCHOS  (J)  , IR ECEP) =R ECDAT  (1 , 1 PCHOS (J) .IRECEP)  ♦ 

. RECDAT  (K,IPCHOS(J)  , IRECEP) 

WRITE  (6 , 2 10) IRECEP,  (R ECEP  (J, I RECEP) ,J=1,2) , 

. (RECDAT  (1,  IPCHOS  (K  ),  IRECEP)  , MIS,  IS  1) 

LNCT=LNCT+1 

IF  (HOD  (IRECEP,  3)  . EQ.O)  WRITE  (6, 260) 

130  CONTINUE 

IF  (IS1.EQ.NP)  GO  TO  140 

IS-IS141 

IS1=NF 


OUTPT000 
OUTPT00 1 
OUTPTOO  2 
OUTPT003 
OUTPTOO  4 
OUTPT005 
OUTPT006 
OUTPT007 
OUTPT008 
OUTPT009 
OUTPTO 1 0 
OOTPT01 1 
OUT  PT0 1 2 
OUTPTO 1 3 
OUTPTO 1 4 
OUTPTO  1 5 
OUTPTO  16 
OUTPT017 
OUT  PT0 1 8 
OUTPTO 19 
OUTPT020 
OUTPT02 1 
OUT  PT022 
OUT  PTO  2 3 
OUTPT024 
OUTPT025 
OUTPT026 
OUTPT027 
OUTPT028 
OUTPT029 
OUTPTO  30 
OUT  PT03 1 
OUTPT032 
OUTPT033 
OUTPT034 
OUTPT035 
OUTPTO  36 
OUTPTO  37 
OUTPT038 
OUTPTO  39 
OUTPT040 
OUTPT04 1 
OUT  PT04  2 
OUTPT04  3 
OUTPT044 
OUTPT045 
OUTPT046 
OUTPT047 
OUTPT048 
OUTPT049 
OUTPT050 
OUTPT05 1 
OUTPT052 
OUTPT05  3 
OUTPT054 
OUTPT0S5 
OUTPT056 
OUTPT057 
OUTPT058 
OUTPT059 
OUTPT060 
OUTPT061 


1 


126 


. 


GC  TO  125  OUTPT062 

1U0  CONTINUE  OUTPT06  3 

200  FORMAT  (1 KO , 96  (1 H-)/2H  I , 2 2X, 3 3 HRECEPTOR  CONCENTRATION  DATA  PROH  , OUTPT064 
. A8, 8H  SOURCES, 23X, 1HI/2H  I, 94 ( 1 H-)  , 1 HI/  OUTPT065 

. 37H  I RECEPTOR  I RECEPTOR  LOCATION  I, 17X, 24 H EXPECTED  AR ITHHETOUTPT066 


IC  BEAN, 18X, 1HI/13H  I NUMBER  1 , 23X , 1HI , 59X , 1 HI/ 
. 2H  1,10  (1H-) , 1HI,23(1H-)  , 1HI,59  (1H-) , 1HI/ 


OUTPT067 
OOTPT06  8 


. 2H  I,1CX,1HI,5X,12H (KILOMETERS)  ,6X,1HI,18X,22H (HICROGR ANS/CU.  HETOUTPT069 
• ER) ,19X,1HI,/2H  I,10X,1HI,5X,1HX,5X,1HI,5X, 1HX,  OUTPT070 

. 5X , 4 (3HI  , A8 , IX) , 3HI  ,A8,2H  I)  OOTPT071 

210  FORMAT  (2H  1 , 16 , 4X , 2 ( 1 HI, F 9 . 3, 2X)  , 1HI , 5 ( 1 PEI  0 . 3 , 2H  I))  OUTPT072 

220  FC8MAT(1H1,9X,20A4/10H  MONTH  = ,A4,12H  PERIOD  = ,A4,4H  TO  , OUTPT073 
. A4,  16H  HOURS  ON  A WEEK, A4)  OUTPT074 

260  FORMAT  (2HI, 10  (1H-) , 1HI, 7(11 (1 H-)  , 1HI) ) OUTPT075 

RETURN  OUTPT076 

END  OUTPT077 


SUBROUTINE  PLRISE 


To  calculate  the  effective  height  and  the  vertical  and  horizon- 
tal dispersion  coefficients  for  a given  stack. 


The  stack  parameters  and  current  meteorological  conditions. 


1.  The  effective  height, 

2.  The  vertical  and  horizontal  dispersion  coefficients, 

o and  a . 

yo  zo 

3.  KSTAB,  a flag  used  in  the  TRAN  function 
= 0,  the  modified  stack  height  is  below  the  lid 

= 1,  the  modified  stack  height  is  initially  above 
the  lid 

= 2,  the  plume  will  penetrate  the  lid. 

Procedure : 

1.  For  point  sources  having  no  plume  rise: 

hef£  = max  (Zg,  Hg,  AZ/2.) 

d = AY/2.4 
yo  ' 

a = AZ/2. 4 
zo 

KSTAB  = 0 or  1 

2.  For  point  sources  which  may  undergo  plume  rise: 

a.  Estimate  the  wind  speed  at  the  top  of  the  aerovane 

b.  Modify  the  stack  height  by  the  effect  of  the  stack 
downwash 

c.  Test  for  building  downwash  effects.  If  downwash  occurs: 

heff  = ^ + ,5LB 

°yo  * °zo  = W1-2 
KSTAB  = 0 or  1 

d.  Test  to  determine  if  the  buoyant  plume  rise  is  significant. 


Purpose: 


Input: 


Output: 


128 


129 


n on  non  n n o n <”> 


SUB'C  n T 1 M F PLF  T3E  (HEFF,KSTAR,  SIGZIN,  SIGYIN) 
t 

C THIS  SUBROUTINE  CALCULA  TES  THE  EFFECTIVE  HEIGHT  AND  THE 
C V ERTICA1  ANT  HOFIZONTAL  DISFFRSION  COEFFICIENTS 
C FOF  A GIVEN  STACK 
C 

REAL  LP 

COMMON  /MET/  VS, WSMPH  ,I«S , WD, IWD , SI NEWD ,COSEVD, JST AB, HLID.TEHF, 
. TEMK.UA 

COMMON  /INFO/  I RECEP, I VNP I R, IT YPE , HTA FRO, XS , YS , ZS , DELY , DELZ, 

. TS, VS,DS,HB,PFFLAG, FHIS (8) , NPOL 
COMMON  /WNDPFC/  XP  (6) 

IF  (PFFLAG . NE . 0)  GO  TO  IOC 
C 

C FOP  AN  APEA  SOUFCE  WITH  A DIAMETER  OF  LESS  THAN  50  METERS 
C THE  EFFECTIVE  EMISSION  HEIGHT  IS  SET  TO  THE  MAXIMUM  OF 
C Z,  THF  BUILETNG  HEIGHT  CR  DELTA  Z/2.0 

C 

H EFF  = AM AX  1 (ZS , H 9 , DELZ/2. ) 

50  KSTAB=0 

IF  (HEFF. GE. HIID)  KST  AB= 1 
GC  TO  230 
C 

100  CONTINUE 
H FP=Z  S 

IF  (FFFLAG. EO- 3)  GO  TO  130 
C 

C FIRST  TESI  FOR  COWNWASH,  THFN  COMPUTE  PLUME  RISE,  IF  ANY 

C 

C FOP  TALL  STACKS  USE  STABILITY  4 IN  THE  WIND  PROFILE  LAW 

C 

J= J ST  AB 

IF  (ZS.GT.60.  . AND.  J.LE.  3)  0=4 

COMPUTE  THE  WINDS PFED  AT  THE  ELEVATION  OF  THE  SIACK 
WZ=1.0 

ZL=AMIN1  (ZS,  304. 8) 

IF  (ZL.GT.HTAERO)  WZ=  (ZL/HTAEPO)  *+XP  ( J) 

U A=  AM  AX  1 ( VS*WZ, 2. 01 

COMPUTE  STACK  DOWNVASH 

HP  = ZS*2.0*  (VS/UA-1 • 5)  *CS 
LE~  HP 

BUILDING  DOWNVASH  TESTS 

IF  (LB.LE. 1.1  GO  TO  110 
IF  (HP.GF. (H8+1.5*LB) ) GO  TO  110 
HPP=HF-1 . 5*LB 

IF  (HP.GT.HB)  HPP=2.0*HP- (HB+1 . 5*  LB) 

IF  (KPF.GT.  (LP/2.0) ) GOTO  110 

BUILDING  DOWNVASH  OCCURS 

HEFF  = HP  + 0 . 5*LP 
SIGZIN=HEFF/1.2 
SIGYIN=SIGZIN 
KST  AB  = 0 

IF  (HEFF. GE. HIID}  KST  AB= 1 
RETURN 


PL  P Sp0C  9 
PLRSFOO 1 
PLRSE002 
PIPSE003 
PLP  SpO04 
PLPSF005 
PLRSE006 
PLR  SEOO  ^ 
PLRSE008 
PLRSE009 
PLRSE010 
PLRSEG1 1 
PLPSE012 
PLPSEO 1 3 

PLPSEOm 

PLPSE915 
PLPSPO 16 
PL  R SEO  17 
PLRSP019 
PLRSEI1R 
PL  R SEP  20 
PLRSE021 
PLRS5022 
PLPSE023 
PLRSF024 
PIRSE925 
PLPSEO  26 
PLRSE027 
PLRSE028 
FLPSE029 
PL  SSE7  30 
PL  P SE0  3 1 
PL  RSp0  3 2 
PLPSEO  3 3 
PLFSF034 
PLPSE035 
PLPRF076 
PL  R S EO  37 
PL  R Sp0  3 8 
PL  E SEO  39 
PLRSE040 
PLRSE04 1 
PLRSE042 
PLRSF04 ’ 
PLRSE044 
PLRSE045 
PLRSF046 
PL?Sp047 
PLPSE048 
PLPSE049 
PI.RSF050 
PI PSE051 
PLRSS052 
PLPSE053 
PLPSE054 
PLRSE055 
PL  RSE956 
PL°SE057 
PLRSE958 
PI  PSE059 
PLRSE060 
PLRSE06 1 


ooo  non  o o o o o o o o o o n o non  ooo 


PI  ppF062 

NC  BUILDING  DOWNWASH,  TEST  FOB  PLUME  BISE  FLRSE063 

PLFSF064 
FI  p F?A6c; 
PI PSF066 

PLdSE9R7 

PLPSE968 
?I PSF069 
PL  RSIO^O 
PLPSED7 1 
PI RSF072 
PLPSE,'73 
PLRSF074 
PLPS’"075 
PLPS5976 

PI RSF977 
PLPS?978 
PL  ?SE97fl 
PL  ° SS08  0 

PLRSF9R  1 

TEST  FOB  INTEBFEBENCE  OF  LID  VITH  MODIFIED  PHYSICAL  STACK  PL  P S F9P  2 

HEIGHT  AND  PLUME  PIPS^OBI 

PLPSE99U 


IF  (HLID.GT.HFP)  GO  TO  220 

PL.nqrnqc, 

PLpSF7R6 

LID  I NTEBFEBES  VITH  STACK  HEIGHT,  USE  STABILITY 

5 WITH 

r; p cfhr  7 

INFINITE  LID  HEIGHT 

F-LPS^OPP 

PL3Pp0B9 

KSTAB=  1 

PLFSE0O0 

GO  TO  225 

PLcgn9  i 
PL  p qtroa  2 

LID  INTERFERES  WITH  PLUME,  USE  STABILITY  5 WITH 

INFINITE  LID 

PL  PSEOP  3 
PLBSF99U 

220  IF  (HLID.GE. HFF)  GO  TO  221 

PI  RSFA95 

KST AE=2 

PLR  Sp096 

GO  TO  225 

PLRSF997 

PLRSPO00 

CALCULATE  PLUME  RISE,  PLUME  CANNOT  PENETRATE  THE 

LID 

PL  PRFOQQ 
PIPS’"  190 

221  KSTAB=0 

PL  p CP  10  i 

IF  (JSTAB.LT. 5)  HEP=H PF+ A MTN 1 ( PIS E (Z SS , JSTA 6)  , 

(HLID-IIPP)  ) 

PI  PSE102 

225  CCNTINUE 

PLRSE 19  3 

HFFF=HEF 

PI  RSP10« 

23C  SIGZIN=DELZ/2.4 

PL  R CP  19  5 

SIGYIN=DELY/2.4 

PL  PCE 106 

RETURN 

PI  PSF107 

END 

PI.  R PE 1 0 9 

110  HFP=HP 

IF  (TS.GT. (TEMK+2.78) ) GO  TO  130 

COLD  PLUME 

HEFF=HPP 
GC  TC  50 
130  CONTINUE 

PLUHE  BISE  EXPECTED  TO  BE  SIGNIFICANT 
CALCULATE  MINIMUM  PLUME  BTSF 

ZSS=HFP 
JJJ  = 5 

DHM IN  = BISF  (ZSS, JJJ) 

HEF=HPP+DHM IN 
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SUBROUTINE  POLSOR 


— 


Purpose: 

To  direct  the  calls  to  the  proper  diffusion  routine  for  all 
input  sources. 

Input : 

1.  Point  source  data  for: 

a.  Environs 

b.  Airbase 

c . Aircraft 

2.  Area  source  data  for: 

a.  Environs 

b.  Airbase 

c . Aircraft 

3.  Line  source  data  for: 

a.  Environs 

b.  Airbase 

c . Aircraft 

Output : 

SORC,  a vector  which  contains  data  for  the  current  source  to  be 
transferred  to  the  diffusion  models. 

Procedure : 

1.  Set  the  receptor  data  array  to  zero. 

2.  Set  the  type  flag  for  environs,  airbase  or  aircraft. 

3.  Fill  the  SORC  vector  with  the  source  description  and 
emission  parameters. 

4.  Check  for  non- zero  emissions  from  this  source  and  call 
STP0L1  for  point  and  area  sources  and  STP0L2  for  line 
sources . 

Subroutines 

Called: 

STP0L1,  STP0L2 
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BEGIN  NABPT  LOOP 


TOR  FAQ!  AIRBASE  POINT 
SOURCE,  FILL  SORC  (1-16) 
FROM  ABPT  ARRAY 


[MISSIONS 
FROM  THIS 
SOURCE 


CALL  STPOL1 


INI)  NARPT  UX3P 


BEGIN  NACH  IOOP 


I OR  FAOI  AIRi:RAFT  POINT 
SOURCE,  FILL  SORC  (1-16) 
FROM  ACFT  ARRAY 


EMISSIONS 
FROM  THIS 
SOURCE 


CALL  STPOl.l 


END  NACPT  lOOP 


onn  non  non  oon 


SUBROUTINE  POLSOP  POLSR000 
C PPLSROO 1 
C THIS  POUTINE  IS  THE  DfilVEP  FOP  THE  DIFFUSION  MODEL.  FOR  ALL  POLSR002 
C ENVIECN,  AIRBASE  AND  AIRCRAFT  POINTS,  AREAS  AND  LINES,  POLSR003 
C THE  SOPC  VECTOR  IS  FILLED  WITH  THE  APPROPRIATE  SOURCE  POLSP904 
C PARAMETERS  AND  THEN  THF  PROPER  DIFFUSION  ROUTINE  IS  CALLED  POLSR005 
C POLS  RO  0 6 


COMMON  /MET/  KS , WS MPH  , INS , WD, IWD , SI N EW D, COS EWD, JS T AB , HLID , TEMF , POLSR007 
. TEMK  PCLSR008 

COMMON  /SRCE/  N POL , NE NPT , N ENAR , NE NLN , N ABPT,  N AB AP  , N A BLN , N ACPT , POLSR009 

. NACAP,NACLN,ENPT(16,  100)  , ENAP  (1 1 , 100)  ,ENLN (14,20)  , ABPT ( 16 , 1 50)  , POLSR010 
. ABAR(1 1,100)  , A BLN (14, 100)  , ACPT (16,1)  ,ACAR(11,24) , ACLN  ( 18 , 25 0)  POLSR011 

CCMMON  /INFO/  IRECEP , IWND IR, ITY PE  , H TA ERO, SORC ( 1 8) , IPOL  POLSR012 

CCMMCN  /AIRQAL/  PECDAT(3,  6,312)  POLSR013 

CCMMON  /XTRAN/  XZ  POLSR014 


SET  PECDAT  ARRAY  TO  0.0 

DO  10  1=1,3 
DC  10  J=1 ,6 
DC  10  K=1,312 
10  PECDAT  (I, J, K)  = 0. 

I FOL  = NPOL 
HTAERC=20. *.3Cu8 

ENVIRON  POINTS 

IF  (NENFT  .EQ.  0)  GO  TO  126 
ITYPE  = 1 
DO  125  1=1, NENPT 
DC  124  J = 1 ,16 

124  SCRC  (J)  = ENPT  (J  ,1) 

DO  224  J=11,  16 

IF  (SCRC  (J) . NE.O .0)  GO  TO  225 

224  CONTINUE 
GC  TO  125 

225  CALL  STPOL1 

125  CONTINUE 

AIPPASE  POINTS 

126  IF  (NABFT  .EQ.  0)  GO  TO  136 
ITYPE  = 2 

DO  135  1=1 , NAfcPT 
DC  134  J = 1,  16 

134  SORC  (J)  = ABPT  (J,I) 

DO  234  J=11,  16 

IF  (SCRC  (J) . NE.O .0)  GO  TO  235 

234  CONTINUE 
GO  TO  135 

235  CALL  STPOL1 

135  CONTINUE 

AIRCRAFT  POINTS 

136  IF (NACPT  .EQ.  0)  GO  TO  146 
ITYPE  = 3 

DO  145  1=1,  NAC  PT 
DO  144  J= 1 , 16 
144  SCRC  (J)  = ACPT (J, I) 

DO  2 44  J=11  ,16 

IF(SORC(J) .NE.0.0)  GO  TO  245 


POIFR01S 

POLSR016 

POLSP017 

POLSR018 

POLSROI 4 

POLS  RO  20 
POLSR021 
POLSR022 
POLSP023 
POLSR024 
POLSR025 
POLSR026 
POLS  R027 
POLSR028 
POLSR029 
POLSPO  30 
POLSR031 
POLSR032 
POLSR033 
POLS  PO  34 
POLSPO  35 
P0LSR036 
POLS  RO 37 
P0LSR038 
POLS  PO  39 
POLSR040 
POLS  PO  4 1 
POLSP042 
P0LSP043 
POLS  PO  4 4 
POLSR045 
POLSR046 
POLSP04  7 
POLS  RO  4 8 
POLSR04  9 
POLSR050 
POLSR051 
POLS  RO  5 2 
POL  SR  05  3 
POLSR054 
POLS  c0  55 
POLSR056 
POLSR057 
POL  SR058 
POLS40S9 
POLSR060 
POLSR061 


244  CCHTINUE 
GO  TO  145 

245  CALL  STPOL1 

145  CCHTI HUE 

146  DC  150  1=1,  18 
150  SOFC  (I)  =0. 

SOEC(IO)  = -1. 

C 

C ENVIFCN  AREAS 
C 

IF  (HENAR  . EQ.  0)  GO  TO  156 
I IT  PE  = 1 
DO  155  1=1 , HENAR 
DO  153  J=  1,  5 

153  SOFC  (J)  = BHAB (J ,1) 

DO  154  J = 6,  11 

154  SORC(J+5)  = ENAR(J,I) 

DO  253  J=11,  16 

IF  (SOFC  (J) . HE.O .0)  GO  TO  254 

253  CCHTIHUE 
GO  TO  155 

254  CALL  STPOL1 

155  CONTIHUE 
C 

C AIFEASE  AREAS 
C 

156  IF  (NABAR  .EQ.  0)  GO  TO  166 
ITYPE  = 2 

DC  165  1 = 1 , M ABAR 
DC  163  J=1 , 5 

163  SCRC(J)  = A BAR  ( J , I) 

DO  164  J=6  , 1 1 

164  SOFC  (J  + 5)  = ABAR  (J  , I) 

DO  263  J = 11  ,16 

IF  (SOFC  (J1  .HE. 0.0)  GO  TO  264 

263  COHTI HUE 
GC  TO  165 

264  CALL  STPOL1 

165  CCNTIHUE 
C 

C AIRCRAFT  AREAS 
C 

166  IF  (HACAR  . EQ.  Of  GO  TO  176 
ITYFE  = 3 

DC  175  1=1, HACAR 
DO  173  J=1, 5 

173  SCRC(J)  = ACAB(J,I) 

DO  174  J=6 , 1 1 

174  SoFC(J  + 5)  = ACAR  (J  , I) 

DO  273  0=11,16 

IF(SCBC(J) .HE. 0.0)  GO  TO  274 

273  CCHTIHUE 
GO  TO  175 

274  CALI  STPOL 1 

175  CCHTIHUE 


C 

C CRITICAL  DISTAHCE,  XZ,  MUST  BE  CONVERTED  10  METERS  FOR  LINE  MODEL 
C 

176  XZ  = XZ  * 1000. 


C 

C BHVIFON  LINES 
C 


POLSR062 
POL  SR  76 3 
FOI.  SR084 
POL  SR  065 
POLSF066 
POLSF067 
POLSR068 
POL  SR  06  4 
POLSP770 
POLSRO7 1 
POLSR072 
POLS  RO  7 3 
POLSRO  7 4 
POLSP075 
POL  SR  076 
POLSR077 
POL  SP  078 
POLSR079 
POL  SF  08  0 
POLSRO«1 
POL  SF082 
POLSR083 
POLSP08U 
POL  S°  08  5 
POLSF086 
pot  SR087 
POLSP088 
POL  SF  0«  9 
POLSR190 
POLSR091 
POLS  P09  2 

PCLSP093 
POLS  R094 
POLSH095 
POLSR096 
POLSR097 
POLSP099 
POLSP099 
POLS  ° 10  0 
POLSF  10  1 
POL  SP 1 02 
POLSF  1C  3 
POL  SR  104 
POL  S F 10  5 
POL  SF 1 06 
POLSF  107 
POLS  R 108 
POL  SR  1 09 
POLSR  1 10 
POL SP111 
POLSF1 12 
POLS  F 1 1 3 
POLSF 1 1 4 
POL  S R 1 1 5 
POL  S?  1 1 6 
POLSR  1 17 
POLSF  118 
POLSF  1 1 7 
pol5  F 1 20 
POL  SP  12 1 
POLSR  122 
POL  SP 1 2 1 
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o n n n n n 


I, 


I?  (NENLN  .EQ.  0)  GO  TO  166 

POLSR 124 

ITYFE  = 1 

POLSP125 

DC  18E  1=1, NENLN 

POL  SP 1 26 

cc  ieu  J = 1,  8 

POLSR12T 

1 64  SOFC  (J)  = FNLK  (J,T) 

POLSR 128 

DO  384  J = 13,  18 

POLS  p 1 29 

364  SCRC  (J) = ENL  N (J-4 ,1) 

POL  SR  1 3 0 

DC  284  J = 1 3 , 18 

POLS  R 1 3 1 

IF (SCRC  (J) . BE. 0.0)  GO  TO  265 

POL  SR  1 3 2 

284  CONTINUE 

POL  S R 1 3 3 

GO  TC  185 

POLS  P 1 34 

285  SCFC(  4)  = 100. 

POLSR 135 

SORC  (10)  = IOC. 

POLSR1 36 

SCRC  (12)  = 1. 

POLSR1 34 

CALL  STFOL2 

POLS  R 1 38 

185  CONTINUE 

POLSR 1 39 
POLS  P 1 40 

AIRBASE  LINES 

POLSR  14  1 
POL  SP  14  2 

186  IF (NABIN  .EQ.  0)  GO  TO  196 

POLSR  14  3 

IT Y PE  = 2 

POLSR 144 

DC  195  1=1, NABLN 

POLSR  145 

DC  194  J= 1 , 8 

POLSR  146 

194  SCRC  (0)  = ABLN  (J,I) 

POLSR  147 

DC  394  J = 1 3 , 1 8 

POL  SR  1 48 

394  SCRC  (J) =ABLN  (J-4, 1) 

POLSP  149 

DO  294  J= 1 3 , 1 8 

P0LSP15O 

IF (SOFC  (J)  . NE.O .0)  GO  TO  295 

POLS  R 1 5 1 

294  CONTINUE 

POLSR  152 

GC  TC  195 

POLSP  15  3 

295  SCRC ( 9)  = IOC. 

POLS  R 15  4 

SCPC(IO)  = IOC. 

POL  SP 1 5 5 

SCRC  ( 12)  = 1. 

POLSR 156 

CALL  STPOL2 

POLSP  154 

195  CONTINUE 

POLSR 158 
POL  SR  1 5 9 

AIRCRAFT  LINES 

POLSR 160 
POL  SR  1 6 1 

196  TF  (NACLN  . EQ.  0)  GO  TO  2C6 

POLSR  162 

ITYPE, = 4 

POLSP  16  3 

DO  *05  1=1 , NACLN 

POLSR  164 

DC  204  J=1,  18 

POL  S P 1 6 5 

204  SCRC  (J)  = A CLN  ( J , I ) 

POL  SR  1 66 

DC  3C4  J=  1 3,  18 

POLSP  167 

IF  (SCRC  (0)  . NE.O. 0)  GO  TO  305 

POL  SP 1 6 8 

304  CONTINUE 

POLSP  169 

GC  TC  205 

POLSP  170 

305  CALI  STPOL2 

POI  SB  171 

205  CONTINUE 

POL  S R 17  2 

206  CONTINUE 

POLSR173 

RETURN 

POLS  R I7  4 

END 

POL  SF  175 
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SUBROUTINE  PSEUDO 


Purpose: 

To  call  the  SIGCY  and  SIGCZ  functions  to  find  the  virtual  distance 
in  meters  from  the  source  to  the  pseudo  upwind  point  source. 

Input: 

1.  Initial  dispersions  in  y and  z directions. 

2.  Wind  speed  and  stability  class. 

Output: 

The  virtual  distances  in  the  y and  z directions. 


Functions 

Called: 


SIGCY 

SIGCZ 
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. ...  . 
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SUBROUTINE  PSEUDO  (DS , WIN  , HS , T Y,TZ| 


¥ 


C 

C 

c 


c 

c 

c 


c 

c 

c 


THIS  SUBROUTINE  CALLS  THE  SIGCY  AND  SIGCZ  FUNCTIONS 
TO  FIND  THE  VIRTUAL  DISTANCE  FRON  THE  SOURCE  TO  THE  PSEUDO 
UPWIND  POINT  SOURCE 


COHHON  /NET/  WS , WSHPH , IVS , WD, T7D, S INEW D, CCSEW D, J ST AB, HL ID, 
. TEHP.TEHK 
COHHON  /WDUN/  WSAVE 


SAVE  THE  INPUT  WIND  SPEED 
WSA  VE  = WIN 

SET  HINIHUH  VALUES  FOR  INITIAL  DISPERSIONS 


ST =D  S 
SZ  =HS 

IF(SZ.LT. 1.) SZ=1.0 
IF (ST. LT. 2. 101) ST=2. 101 


FIND  DISTANCES  IN  HFTERS 


TY=SIGCY (JSTAP, SY) 
T7=SIGCZ  (»1STAB  , SZ) 
RETURN 
END 


PSUDOOOO 

PSUDO001 

PSUDO002 

PSUD0003 

PSUDO094 

PSUDO005 

PSUDO006 

PSUDO007 

psuDoooe 
PSU  D0009 
PSUDO010 

psupoon 

PSUDO012 
PSUDO01 3 
PSUD0014 
PSUD0015 
PSUDOO  16 
PSUDO017 
PSUDOO  18 
PSUDO019 
PSUDOO  20 
PSUDOO  2 1 
“SUDO022 
PSUDOO  2 3 
PSUDO024 
PSUDOO  26 
PSUDO026 


rr  z 
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SUBROUTINE  qMOD 


Purpose: 

To  compute  the  linear  distribution,  in  inverse  length,  of  the 
pollution  along  a runway  due  to  aircraft  emission  during  landing 
or  takeoff. 


Input : 

YSI  Distance  along  runway  measured  from  tip  of  exhaust 
plume  near  starting  end  of  runway 

TAIL  Length  or  penetration  of  exhaust  plume  of  aircraft 
at  rest 

DL  Length  of  smoke  slug  on  runway 

A Acceleration  (or  deceleration)  of  aircraft 

V12  Initial  velocity  squared 

VS  Average  velocity  of  exhaust  particles  relative  to 
air  mass  in  exhaust  plume 

WS2  Wind  speed  squared 

WSC  2* wind  speed* (-  cosine  of  angle  between  runway  and 

wind  vector) 

RR  A/G,  where  A is  acceleration  and  G is  the  normali- 
zation constant  for  line  density 


r- 


Output : 


QL  The  linear  distribution  of  pollution 


Procedure : 

1.  Convert  the  quantity  YSI  to  XSI,  the  distance  measured 
from  the  physical  end  of  the  runway. 

2.  Use  the  line  density  formula  to  compute  QL  in  inverse 
length. 

Subroutines 

Called: 

— 

None 
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SUBROUTINE  QHOD  (YS1.QL) 

THIS  ROUTINE  COHPUTES  THE  LINEAR  DISTRIBUTION,  IN  INVFRSE  LENG 
OF  THE  POL I US ION  ALONG  A RUNWAY  DUE  TO  AIRCRAFT  EHHISION 
DURING  LANDING  OR  TAKEOFF 

COHHON  /INFO/  IPECEP, IWNDIR,ITYPE,HTA£RO,X1, Y1,Z1,N,DELZ,X2, 
. V1,V2,DL,TIHE,FHIS(6) , NPOL 

COHHON  /LN/  XW1,YV1,ZV1,XV2,YW2,ZW2,SUD3Y,SUDOZ,IAD,TAIL, A,V 
. WS2 , WSC, RP , SP 
XS1  = YS 1 - TAIL 

IF  (XS1  .LE.  -TAIL)  XS1  = -TAIL  ♦ .001 
IF  (XS1  .GT.  PL)  XS1  = DL  - .001 
FXSI  = 0. 

IF  (XS1  .GT.  (DL-TAIL) ) FXSI  = XS 1 - DL  ♦ TAIL 
30  XSIB  = XS1  + TAIL 

IF  (XSIB  .GT.  DL)  XSIB  = DL 
XSIA  = 0. 

IF  (XS1  .GT.  0)  XSIA  = XS 1 

ROOTB  = V12  ♦ 2.*A*XSIB 

ROOTA  = V12  ♦ 2 . *A*XST A 

VA  = SQRT (ROOTA)  ♦ VS 

VB  = SQRT  (ROO""B)  ♦ VS 

YA  = SQRT (BS2  ♦ VA  *(VA  ♦ WSC)) 

YB  = SQRT  (WS2  ♦ VB  *(V3  ♦ WSC)) 

ARG  = (YB  ♦ VB  ♦ ''SC/2.)  / (YA  ♦ VA  ♦ WSC/2.) 

QL  = YB  - YA  - WSC/2.  * ALOG (ARG) 

QL  = RR  / TAIL  * (PXSI  / SP  ♦ QL  / A) 

RETURN 


QMOD0000 
ONODOOn 1 
TH,  QHODOOO  2 
QHOP000  3 
QHOD000W 
QTODOOO  5 
Y?,Z2, Q10D0006 
QHOD0007 
12, VS , QNODQOO  8 
QHOD0009 
(>M  0 DO  0 1 0 
QHOD001  1 
QtlODOOl  2 
QHOD001 3 
QHOD001U 
QNOD001 5 
QHOD00 1 6 
QHOD001 7 
QHOD00 1 8 
Q* OD0019 
QHOD0020 
QNOD002  1 
QH OP 002  2 
0HOD0023 
QHODOO 2U 
QHOD0025 
QHOD0026 
QNOP0027 
QHOD0028 
OHOD002P 
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SUBROUTINE  READ 


Purpose: 

1.  To  read  master  source  tape,  thereby  providing  the  emission 
inventory  and  related  data  to  the  source  emission  distri- 
bution subroutines. 

2.  To  set  up  the  wind- dependent  sources  as  random  access 
disk  data  sets. 


Input: 

Master  source  tape. 


Output: 


ARRFCN,  DEPFCN  to  disk. 


SUBROUTINE  READ  (Continued) 
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SUBROUTINE  PEAD 

THIS  ROUTINE  READS  THE  MASTER  SOURCE  EMISSION  TAPE 

REAL  LNESPD 
INTEGER  ENGNO 

COMMON  /ANNMET/  TB AR , ADD, P, P A, WSB AR, DT b AR 
COMMON  / RECPT  / MR  EC PT, MA XFIL 

COMMON  / DEFALT  / IT  APE, ACLNDY, ACLNDZ, ALPH A (7) , BETA ( 7)  , FI  DENS  (7) 
COMMON  /ACEDB1/  ACEM FC  (8 , 10, 6)  , ASCNT 1 (6)  , ASCNT2  (8)  , TXIS PD ( 8)  , 

. LNDSPD  (6)  , APSPE1 (8) , APSPD2(8)  ,COHT1 (8)  ,TOSPD (8) .COSPD1  (8)  , 

. COSPD2  (8) , SRTUPT (8)  ,ESCNT1(8) , EGCHKT (8) ,SHTDNX(8)  ,DSCNT2(8)  , 

. APPHT,APPHT2(8) , CLMB HI, TO WT ( 8)  , ENGNO  (8 , 2) , ID RR  (8) 

COMMON  /ACEDE2/  NACTYP,NRNWYS , NPKAR, IEGFLG, IACTYP (8) , ANNARR (8)  , 

. ANNEEP  (8) , ANNTGO  (8 ) , ARRFCN  (24, 8, 6)  , DEPFCN  ( 24 , 8, 6)  ,TGO(3,4,8) , 

. DISfiNU  (6) , RNWY  (7,6) , IUSWD(20,6)  , ACFUEL  (8) , ARFLVT (8)  , DPFLVT(8) , 

. ACSPII  (8) , ARSVEM (6,8,5)  , DPS V EM (6 , 8 , 5)  ,NIBTT(6)  , N IBS  EG ( 8, 6 ) , 

. II BS EG  ( 1 6 , 8, 6) , ID IBTW  (8 , 6) , TT ARFR (8 , 8 , 6)  ,NOBTT(6)  , NO BS EG ( 8, 6)  , 

. IOBSEG  (16, 8,6)  ,IDOBTW(8,6) , TTDPFR (8 , 8 , 6) ,NPASQ(6)  ,IDPRKA(6)  , 

. PA  REA  (6,3,3) ,IDIBPA(8,6)  ,IDOBPA(8,6)  , NLSEGS, ACLNSG ( 1 2, 25)  ,JES1  (8) 
COMMON  /SRCE/  NPLTS , NENPT , NENA R , NENLN , NABPT , N AB AR , N ABLN , NACPT, 

. NACAR,NACLN,ENFT(16, 100) , EN AR ( 1 1 , 1 OC) , ENLN (14,20), A3PT (16,150), 

. ABAR  (11,  100) , ABLN  (14, 100)  ,ACPT( 16, 1)  ,ACAR(  11 ,24)  , ACLN ( 1 8, 25 C) 
COMMON  /DSTRET/  ACMO  ( 1 3, 8) , ACDY  (2 , 8)  , ACHR  (2 4 , 8)  , V HMLMO  ( 1 3)  , 

. VHMLDY  (2) , VHMLHR (24)  , CV A BMO ( 1 3)  , CV AbDY ( 2) , CVABHh (24)  ,CVENMO  (13)  , 

. C V ENDY  (2) , CVEN HR ( 24)  ,FLMO(13,7)  ,FLDY  (2 , 7 ) , F LH R (24 , 7)  ,NC1 

REAL  (ITAPE)  NPLTS , NPKAR , NRNWYS , NACT Y P, NWD, APPHT , CLM EHT , I EGFLG 
. , NLSEGS 
REWIND  30 
DC  2 1=1, NWD 
DC  5 J=1 , N ACTYP 

READ  (ITAPE)  (( ARRFCN  (L,J , K)  , DEPFCN  (L , J , K) , L= 1 , 24)  , K=  1 , 6) 

5 CONTINUE 

WRITE  (30) ARRFCN, DEPFCN 
2 CONTINUE 
REWIND  30 
MBECPT=  1 
MAXFIL=NWD 

READ  (ITAPE)  ( J ES 1 (I)  ,1= 1 ,NACT YP) 

READ  (ITAPE)  TB AR, ADD , P A, WSBAR, DTBAR 

BEAD  (ITAPE)  V HMLMO , VHHL  <,VHMLqrLc6a6mO‘-ceaAAh,c  aAer<-c  enM  t-T 
. CVENDY,CVENHR,FLMO,FLDY,FLHR 
READ  (ITAPE)  NIBTT , N IBSEG  ,IIBSEG , NOBTT , NOBSEG , IOBS EG 
READ  (ITAPE)  IDOBTW , IDIBTW, ID FRKA , PA  REA , IDI BP A , I DOBPA , NPASQ 
READ  (ITAPE)  R NW Y , IUS WD , DISR NW 

READ  (ITAPE)  ( ( ACLN SG  (II , J J)  , 1 1= 1 , 12) , J J= 1 , NLSEGS) 

DC  40  J= 1 , N ACTYP 

READ  (ITAPE)  (ACMO  (K , J)  ,K  = 1 , 13) , (ACDY  ( K , J)  , K= 1, 2) , ( AC  HR  (K , J)  , K = 1 , 24 ) 
PEAD  (ITAPE)  ANNARR (J) .ANNDEP  (J)  ,ANNTGO(J)  ,ACFUEL(J)  , ARFLVT  (J)  , 

. DPFLVT  (J)  ,ACSPIL(J)  , IACTYP ( J) 

READ  (ITAPE)  DSCNT 1 ( J ) ,DSCNT2  ( J)  , ASC NT1  (J ) , ASCNT2  ( J)  , 

. TXISPD(J)  , LNDSPD ( J)  ,APSPD1(J)  , APSPD2 (J) , TOSPD  (J)  ,COSED1  (J)  , 

. COSED2  (J) , SRTUPT  (J)  , EGCHKT (J) , S HTD NT  (J) ,TOWT(J)  , APPHI2(J)  , 

. COHT1  (J)  , I DRF  (J) 

READ  (ITAPE)  ( ( ARS  VEM  < K , J , L)  , DPS  V EH  ( K,  J,  L)  , L=  1 , 5)  , K = 1 , 6)  , 

. ( (TTARFR (K, J, L) , TTDPFR (K ,J, L)  , K=  1 , 8)  , L= 1 ,6) 

READ  (ITAPE)  (ENGNO  ( J, L) , L=1 , 2) , ( ( ACEH FC ( J, K, L) , K= 1 , 10 ) , L= 1 , 6) 

READ  (ITAPE)  ( (TGO  (K,L,J),K=1,3)  , L=  1,  4) 

40  CONTINUE 
4 READ  (ITAPE, END=3) 

GO  TO  4 


PEAD0000 
READ0001 
REAT0002 
P E ADC  00  3 
READ0004 
R E A DO  00  5 
P E ADO  006 
PE AD0007 
READ0008 
R EA  DO  009 
READ0010 
PEAD001 1 
READCO  12 
READ001  3 
REA.DC014 
RE A DO  0 1 5 
READ0016 
SEAD0017 
PEADOO  18 
READ0019 
RE  A DO  0 20 
READ0021 
PEAD0022 
PE ADO  0 2 3 
READ0C24 
RE  A DO  0 25 
READ0026 
READ0027 
F E ADO  0 28 
PE  A DO  0 29 
PE  ADO  0 30 
READ0031 
PE  A DO  0 3 2 
P E ADO  0 3 3 
REA  D0034 
READ0035 
RE  ADO  0 36 
PE  A D00  37 
READ0038 
PEADOO  39 
READ0040 
PE AD004  1 
PEAD0042 
P E A DO  04  3 
PEA  DO  04  4 
READ0045 
READ0046 
PEAD0047 
R E A DO  04  8 
P E A DO  04  9 
PEAD0050 
RE  A DO  05  1 
RFAD005 2 
READ0053 
PE AD0054 
READ0055 
F E A DO  0 86 
FEAD0087 
RE  A DO  05  8 
B E A DO  0 59 
R E A DO  060 
F E A DO  06  1 
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FUNCTION  RISE 


To  calculate  the  plume  rise  using  either  the  Carson-Moses  or 
Holland  plume  rise  formula. 


Input : 


Stack  parameters,  current  wind  speed  and  stability,  temperature, 
and  the  plume  rise  flag. 


Output: 


The  height  of  the  plume  rise. 


Subroutines 

Called: 


1S8 


non  nnn  non  nnnn  non  nnn 


t ... 


c 

c 

c 

c 

c 

c 


FUNCTION  RISE (ZSS, JJJ) 

THIS  FUNCTION  CALCULATES  THE  PLUME  RISE 

ZSS  IS  THE  PHYSICAL  STACK  HEIGHT  MODIFIED  FOR  DOWNPASH 
EFFECTS,  IF  ANY 
JJJ  IS  THE  AMBIENT  STABILITY 

COMMON  /MET/  W S , WSM PH , I WS , WD, I ED , SI NE WD ,COSE HD, JST AB, HLI D, TE MF, 
. TEMK 

COMMON  /INFO/  TFECEP,IWNDIR,ITYPE,HTAERO, XS , YS , ZS , DELY , DELZ , 

. TS,VS,DS,HB,PRFLAG,EMIS(8) ,NPOL 
DIMENSION  A (b)  , FJ  (6) 

COMMON  /VNDPRO/  X P (6) 

DATA  A /2. 65, 2. 65, 2. 65, 1.08, 2*0. 68/, 

FJ  / 1.2, 1.2, 1.2, 1.0, 0.8, 0.8/ 

P ISE  = 0 . C 


CHFCK  THE  STACK  EXIT  GAS  TEMPERATURE 
IF  (TS.FQ.0.0)  RETURN 

FOR  TALL  STACKS  USE  STABILITY  4 IN  THE  HIND  PROFILE  LAV 


J=JJJ 

IF  (ZSS.GT.6  0. AND. J.LE. 3) J=4 


COMPUTE  THE  WTND  SPEED  AT  THE  ELEVATION  OF  THE  STACK 
FOR  STABILITY  J 

WZ=1 . 0 

ZL  = A M IN  1 (ZSS,  304.  8) 

IF  (ZL.GT.  HTA.ERO)  WZ=  (ZL/HTAERO)  **XP(J) 

U=AMAX1 (NS* HZ, 2.0) 

COMPUTE  THE  THERMAL  EMISSION  RATE 

QH  = f 7. 0*DS*r>c*VS*ABS  (TS-TEMK)  /TS 
IF  (PRFLAG. EQ. 1.0)  GO  TO  1 
IF  (PRFLAG. EC. 3.0)  QH=  TS 

CARSON- MOS  ES  PLUME  PISE  FORMULA 

F ISE  = A (J)  *5.  3S*  SQRT (QH) /U 
FFTURN 

HOLLAND  PLUME  RISE  FORMULA 
1 CONTINUE 

®ISE=1  .S*VS*DS/M  + 0. 04*QH/'J 
PISE=PISE*FJ  (J) 

RETURN 

END 


RISE0000 

RISE0001 

RISE0002 

RISE0003 

RISE0004 

RISE0005 

RI SE0006 

RISE0007 

RISE0008 

RISE0009 

RISE0010 

RISE001  1 

RISE0012 

RISE001 3 

RISE001 4 

RISE0015 

RISEOO 1 6 

RTSE0017 

RISE001 8 

RISE0019 

RISE0020 

RTSE0021 

RISS0022 

RI5E002  3 

RISE0024 

RISE0025 

RISE0026 

RISE0027 

RISE0028 

RISE0029 

RISE0030 

RISE0031 

RISE0032 

RISE0033 

RTSF0034 

RISE0035 

RTSE0036 

RISE0037 

RISE0038 

RISE0039 

RISE0040 

RISE004 1 

RISE0042 

RISE004  3 

RISE0044 

RISE0045 

RISE0046 

PISE0047 

RISE0048 

RISE004  9 

RISE0050 

RISE0O51 
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FUNCTION  RRDIST 


To  calculate  the  length  of  runway  necessary  for  takeoff  using 
aircraft  dependent  equations. 


Aircraft  identification,  pressure  altitude,  ambient  temperature 
and  wind  speed,  and  aircraft  takeoff  weight. 


Takeoff  length  in  feet  of  runway  roll  to  liftoff 


For  a given  aircraft,  use  the  proper  set  of  takeoff  equations 
provided  by  the  USAF. 


Subroutines 

Called: 


FUNCTION  RRDTST  ( IR , P A , T, GW, WS ) 

FUNCTION  CALCULATES  RUNWAT  ROLL  DISTANCE  IN  FEET 

IR  IS  AIRCRAFT  IDENTIFICATION  NUMBER 

PA  IS  PRESSURE  ALTITUDE  IN  HUNDREDS  OF  FEET 

T IS  TEMEERATURE  IN  DEGREES  FAHRENHEIT 

GW  IS  AC  TAKE  OFF  WEIGHT  IN  THOUSAND  POUNDS 

WS  IS  THE  WIND  SPEED  IN  KNOTS 

FGR  = 0 . 0 

IF (IR.EQ. 100)  GO  TO  100 

GO  TO  (1,2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,1 5, 16,17, IB, 19, 20, 21, 22, 
123,24,25,26,27, 28,29, 30,31 ,32,33,34,35,36,37, 100, 100, 100, 100,100, 
2 10  0,  100,  100,100,  100,  100,100,12)  ,IR 
CONTINUE 
GC  TO  100 
CONTINUE 

TCF=-  (2.79-8.57  14E-4*PA) + ( 1 . 82E- 2 +7 . 2857E-5*P A) *GW 
GR=  (1.  184  E + 1-4.  2167  E-  1*T  + 1 . 0E- 2*T**  2- 4 . 58  3E- 5*1** 3)  ♦ 

(4 . 194+ 1. 7197E-2*T- 9.  260 18E-4* T**2)  *TOF  + 

<1 .0457+8.4 CE-3*T+2.  1 17E-4*T**2+2. 98E-7*T**3) *TOF**2 
FGR=  (GR-  (1.  15E- 1 + 9. 0E-3*GR) *WS) * 100. 

GC  TO  100 
CONTINUE 

TOF=  (1. 589+6. 883E-3*PA+1.2767E-4* PA **2)  ♦ 

(b.819E-3+1. 1007E-4*PA-3.924E-7*PA**2) *T  + 

(5. 979E-5+3. 38096 E- 7*PA +8. 532E-9*PA**2) *T**2 
GR=  <-13.25+8.75E-1*GW-1.25E-2*GW**2)  ♦ 

(1. 3925E+1-9. 275E-1*GW+2.125E-2*GW**2) *TOF 
FGR= (GR- (1. 316E-1+8.748E-3+GR) ♦WS) *100. 

GC  TO  100 

TOF  = (9.3937E-1  + 2.0947E-2*PA  + 2.005E-4*PA**2)  ♦ 

( 3 . 746467 E- 2+4 . 0 562 5E-4*PA) *T+ 

(1 . 9928E-4-5. 75006 E-6*P A ♦ 1 . U0234E-7*PA**2) *T**2 
GR=  (1.4307E+1-7. 57144  E- 1* GW+ 2 . 678 5E- 2*GW**2)  + 

. ( 1 . 67257  E+ 1 - 1 . 17762*GW  + 2.7381E-2*GW**2) *TOF 

FGP  = (GP-(2.4  12799E-2+7.82  971E-3*GR) *WS) *100. 

GO  TO  100 

TCF=  (-1.06E-3+1.67  4E-2*PA  + 8.  1 888E-5*PA**2) ♦ 
(1.36E-2+9.592E-6*PA+1.755E-6*PA**2) *T+ 

(5. 1099E-5+1.2899E-6*PA-6. 1 23E-9*P A**2) *T**2 
Gfi  = (-1.423E+1+6.349998E-1*GW+1.6667E-3*GW**2) + 

. (6. 1857-3.2179E-1*GW  + 8. 2 1 4F-3*GW**2) *TOF 

FGR  = (GR-  (6. 293E-2  + 7.  328E-3*GR) *WS) *100. 

GO  TC  100 

TOF=  (9. 503 E- 2+3. 31 3E-2*PA  + 1. 3666E-4*PA**2)  ♦ 

. (2. 2546E-2+  1 . 7848  E-4  + PA-4. 04E-6*PA**2) *T+ 

. ( 1 . 34  38E- 4-1. 2166 E-6*PA+4.  1 8 54E-8*PA **2) *T**2 

GR=  (2. 95E+ 1-2. 394  + GW+6. 4 97 E-2 *GW**2)  ♦ 

(3. 1035+7. 52E-2*GK- 3. 186E- 3*GW **2) *TOF+ 

< 1. 2715-1 .55  35E-1+GW  + 4. 3 889E-3*GW**2) *TOF**2 
FGR=  (GR-  (-9 .0E- 2+1. 80  7E-2*GR-7. 1 4 3E-5*GR** 2) *WS) *10  0. 

GO  TO  100 

TCF=  (3. 36455 E-  3+5 . 635  56E-2*PA)  ♦ 

(4. 417E-2-2.031E-3*PA+5.63E-5*PA**2-3.9954E— 7*PA**3) *T+ 
(-9.2E-5+2.C8E-5*PA-5. 39E-7*PA**2+3 . 8E-9*PA**3) *T**2 
GR= (1. 65838-3. 0o9E-1* GW +8. 1 36 3E- 2*GW ♦ *2) ♦ 

. (-3. 6111+3. 63559E-1*GW) *TOF+ 

. (7. 3975E- 1-8.78749E-2*GW+3. 2487E-3*GW**2) *TOF**2 

FGR  = (GR- (5. CE-2+7. 4E- 3*GR) *WS)  *100. 

GC  TC  100 

TCF=  (12.5546-5.  719 2 E- 2*PA+ 1 . 3075E-4* P A**2)  - 
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. (2. 9032E-2-1. 0254E-4*PA-1. 45125E-7*PA**2) *T 

GR= ( (-5.  1 4955E+ 1+2. 57957*GW- 1 . 4425E-2*GW**2)  - 
. (-1. 1535E+1+5.915E-1*GW-4.6828E-3*GW*»2)*TOF+ 

. (-6.2285E-1+3.2375E-2*G«-2.9056E-4*GW**2)  *T0F**2)  *1000. 

FGR  = (3. 30 5E +1+9. 729 E- 1+GR+2. 31E-6*GR**2) - 
. (8.244+8. 3598E-3*GR-1. 44E-8*GR**2) *WS 

GO  TO  100 

11  TCF=  (7.436E-1+U.29E-2*PA) ♦ (2.  1 276 E- 2- 3. 1 1 16 E-5*f A) *T 
GR= (1.638E+1-7.78E-1*GN+2.84E-2*GV**2)  ♦ 

. (3.609-1.947E-1*GW+4.264E-3*GH**2) *T0F+ 

. (-1 .976E-1+1.5757E-2*GW+4.6 189E-4*GW**2) *TOF**2 

FGR= (GR- (8. 5E-2  + 8.  2 5E-3  + GR) *WS) *100. 

GC  TO  100 

12  TCF=  (1. 1405-4. 659£-3*FA  + 1. 28E-5*PA*  + 2)  - 

. (2.0146E-3-2.46E-5*PA  + 3.5514E-7*PA**2)  *T 

GR=  (-3.0029E+1-9.6225E-2*GW+1.25428E-1*GW**2)  - 
. (-7.3845B+1+1.20433*GW+1.7857E-1*GW**2) *I0F+ 

. (-3.57857E+1+7.857E-1*GV+7. 1 4286E- 2*GH * *2) *T0F**2 

FGR* ( (3. 17413E-1  + 9.76  2E-1*GR  + 2.657E-4*GK**2)  - 
. (1. 1114 E- 1+7. 91177E-3*GR+4.  40 169E-5*G R**2) *W S) * 1 00 . 

GC  TO  100 

13  TOF* (9.166-5.485E-2*PA) -(3.412E-2-1 .8E-4+PA) *T 
GR  = (3.02E  + 2-3. 519E+1*GW+1 . 8«1*GW**2)  - 

(1.306E+2-1.277E+1*GW+5.4E-1*GW**2) *TOF+ 

. (2.0687E+1-1.715*GW+6.07E-2*GW**2) *TOF**2- 

. (1. 1578-8.4228E-2*GW+2. U6E-3*GW**2) *TOF**3 

FGR= (GR- (9. 55E-2+7. 15E-3*GR) *WS) *100. 

GO  TO  100 

14  TOF= (2.336+ 1 . 58 2E-2*P A+ 1 . 172E-4*PA**2) ♦ 

. (5.604E-3+9.97746E-5*PA-5.8117147£-7*PA**2)  *T+ 

. (9. 19269E-5- 1.34 357 E-8*PA+ 1.614  1 IE- 8*PA**2) *T**2 

GR=  (7. 7366-2. 52997E- 1 *GW+ 2. 385E- 3*GW* * 2) ♦ 

. (-2. 1071+4. 2586E-2*GW+ 1 2 . 748E- 4 *GH**2) *TOF 

FGR=  (GR-  (1. 0755 E- 1+1. 4588 E-2*GR-7. 941 56 E-5*GR**2) *KS)  *10C. 
GC  TO  100 

15  CONTINUE 
GC  TO  100 

16  TOF=  (7.68  59-1.  1 5E- 1 *P A + 4 . 4 13E-4*PA** 2) - 

. (2. 925E-2-8. 1 128E-4*PA+6 . 999E-6*PA**2) *T- 

. (2.2 289E-4+5.054E-6*PA-7.57E-8*PA**2) *T**2 

GR=  (2.546E+  1-2.  3388*GH+1.0717E-1*GH**2) - 
. (7. 9095-6. 7434E-1*GW+2. 1 045 E-2*GW** 2) *TOF+ 

. (6.099E-1-5.0858E-2*GH+1.434E-3*GH**2) *TOF**2 

FGR=  (GR-  (1. 16E-1  + 7. 27E-3*GR-3. 64E-6*GR**2) *HS) *100. 

GC  TC  100 

17  CCNTINOE 
GC  TC  100 

18  TOF= (2.  118+1.05  8E-2*PA+1. 0 14E- 4* PA**2 ) ♦ 

. (2. 102E-3+1. 84E-4*PA-1. 177E-6*PA**2) *T+ 

. (1.001E-4-7.046E-7*PA+1. 355P-8*PA**2) *T**2 

GR=  (1.0E-5)  ♦ (- 1.9687+ 4. 209E-  1*Gtf  + 3.  94  4 5E-2*GH**2)  *TOF 
FGR=  (GR-  (8.  36  3E-2+1. 4 88E-2 *GR-9 . 78E-5*GP* *2) *NS) *100. 

GC  TO  100 

19  TCF=  (4.6547  8+6. 9444  4E-3*T) ♦ (3 . 257E- 1 + 2 . 77 78 E-4* I) * (PA/10.) 
GR= (.  1457  + 3. 5625E-2*GW-6. 763E-5*GW**2) ♦ 

(5.1428-3.  175E-2*GW+7. 0C89E-5*GH**2) *TOF 
FGR= (GR- (. 1+.0082*GR) *HS) *100. 

GO  TC  100 

20  TOF= (1. 2192956+2. 209 1 577E-3*P A+3 . 380 1 0 2E- 4* P A**2) ♦ 

. ( 1.4628966E- 2+2. 631 3968E-4*PA- 1.381 8053E-7*PA**2) *T- 

. (2.4891E-4-6.875E-6*PA+7.8125E-8*PA**2) *1**2+ 

. (2.20314E-6-6.49E-8*PA+7.47E-10*PA**2) *T**3 
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. I >1 .1 W urn*  W.U. . IH.MI 


GF  = ( (2 . 3806  396-  5.  9265 772E-2*GW+6. b7969E-4*GW**2) ♦ 

(-  1.  1993  3136*  5.04 1098E-2*GW- 2. 1 25 17E-4 *GW **2) *TOF) * 10. 

P Gh  = (1.0*9.7757  143E*1*GB*6.4285714E-2*GR**2)  - 

(4.6785706*5. 427 551 SE-1*GR*4. 43 8775E-3*GR** 2) *WS 
GC  IC  100 

21  TOF  = (-4.799107E-1  ♦ 3 . 3 16 5 179F-2* PA  *2.  7902E-4*P A**2)  ♦ 

. (2.129E-2  ♦ 2.2538E-4  * PA  - 2.9186E-6  * PA  **  2)  * T 
GF  = (1.16103  ♦ 5.318E-2  * GW  ♦ 9.0525E-4  ♦ GW  **2  ) ♦ 

. (3.3695E1  - 6.94276E-1  * GV  ♦ 3.8559E-3  * GW  **  2 ) * TOF  - 
. (-9.041  ♦ 2.307E-1  * GW  - 1.264E-3  * GW  **  2 ) * TOF  **  2 ♦ 

. (-1.07C6  ♦ 2.477E-2  * GW  - 1.108E-4  * GW  **  2 ) *TOF  **  3 

FGP=  (GB-(2. 41312-1*2.  115E-4*GR  ♦ 1. 93SE-4*GR**2) *WS) * ICO. 

GC  TC  100 

22  CONTINUE 

23  TCF= (3.91 16E-2*6. 3976E-2*PA> ♦ ( 1 . 6 557 E-2-7 . 6643E-6* P A) *T 
GR=  (5. 625-9. 5E- 2*GW* 1 . 31 25E-3 *GW * *2)  ♦ 

. (6. 6496 E-  1-  1.  2768 E- 2*GW*  1 . 077e-4*GW**2) *TOF* 

(4 . 0067  E- 1 -5 . 38  2E-3*GW*3.627E-5*GW**2) *TOF**2 
FGE=(GB-(1.5CPE-1*8.625E- 3*GR) *WS) *100. 

GC  TC  100 

2«  TCF=  (5.4067 E* 1-1. 3 3 75 E- 1* F A- 2.  27 55E-4*P A* *2*3 . 6508E-6 *P A** 3) - 

(7. 395E-2-1 . 71E-4*PA-5. 9 1 E-6*PA** 2* 4 . 22E-8*FA**3) *T 
GR=  (8.6549E*3-7.75196E*1*GW*2.07846E-1*GW**2)  - 
. (5.6302E+2-4. 9948*GW*1. 30519E-2*GW**2) *TOF+ 

. (1. 22509E*  1-1 .07805E-1*C-W*2. 759985E- 4 *GW**2)  *TOF**2- 

. (8. 8948E-2-7. 7746 3E-4*GV+1 . 95b403E-6*GW**2) *TOF**3 

FGR= (GR- (1. 4 12  3219E-1  *8. 5 2935 78E-3*GR* 5 . 709895E-6 *GS* *2) *VS)  *100. 
GC  TC  100 

25  TOF=  (7. 90371*6. 68965E-2*PA*2.  1 26 2 2E-4* PA**2)  ♦ 

(3.00808E-2*2. 671 18E-5*FA*9. 85E-6*PA**2) *T* 

. (1.23149E-4*1.3589E-6*PA-3. 164 1 E-8*PA**2) *T**2 

GR=  (2. 17428 57* 2. 04 2 86 E-1* GW-  1 . 07 1 4 29E- 2*G W* *2)  ♦ 

(1. 14943-1. 27 07 E-1* GW *5. 1785E-3*GW**2) *TOF 
FGR=(GR-(-2.7327E-2*1.904E-2*GB)*WS* 

. (-6. 308C77E-4  + 1 . 946  54  E- 4 *GP ) *WS**2) *100. 

GC  TC  100 

26  CONTINUE 

27  CONTINUE 

28  CONTINUE 

29  TCF=  (7.83  93  5E-  1*5.  381  89E-2*PA> ♦ 

(1 .2040eE-2*9.888357E-5*PA-2.32448E-6*PA**2) *T- 
(9.72E-6*1.827bE-6*PA-2.405E-8*PA**2) *T**2 
GR=  (3.  18978 E* 1-1. 78 5* GW* 3.602 E- 2* GW** 2)  ♦ 

. (-8 .8285*5.  1387E- 1*  GW-5. 679 E-3 *GW **2) *TOF* 

(-1.76441*4. 82709E-2*GW) *TOF**2 
FGR=  (GR-  (8. 64 5 7 E- 2*  1.  14  14F-2*GR) *WS) * 100. 

GC  TO  100 

30  TCF  = (-2. 890  5 14 E-1*  5.  8370« 56E- 2* P A)  ♦ 

. (4.  161561E-2-3.518445E-5*PA)  *T* (-6 . 05 15E- 5* 3.  5309 5E -6*PA) *T**2 

GE= (-2.684337E* 1*3. 224954*GW) ♦ (-2 . 0 58 1 5 1 9*3 . 7024 356 E- 1 *GW) *TOF* 
(-8.8b13S7E-1*8.  309 3 188 E- 2*G W) *TOF**2 
FGR=  (GR-  (1.  3583  3 3 3E-1  *9 . 5 8 33E- 3*GP.)  *WS(  ♦ 100. 

GC  IC  100 

31  TCF=  (7.4627 5E- 1 *1.789 924E-2*P A* 1.  6677 29E-4* P A** 2)  ♦ 

(6. 1017875E-3*3.4816947E-4*PA-1.6406229E-6*PA**2) *T* 
(1.718525E-4-2.621825E-6*PA*4. 1 84375E-8*PA**2) *T**2 
GF=  (-7.2378129E*1*3.8  4 856  84E+1*GW-6.  565*G W* *2* 3 . 9 1 6E- 1 *GV* *3 ) ♦ 

. (-5.4  77E*  1*2.92E*1*GW-4.975*GW**2*2.9C6E-1*GW**3) *TOF 

FGR=  ( (-1.607758*1. 2 22 176* GR-5. 64  3 75E-3*GR** 2)  - 

( . 482382E  - 1*2. 2260  1 52E-2*GR-4.  74621  16E-4*GR**2) *WS) *100. 

GC  TC  100 

32  TCF  = (1.996*  1. 69 E-2*PA *2. 56E-5*PA**2)  ♦ 
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. <6.64E-3-7.5E-5*PA*1.6lF-6*PA**2) *T 

GR  = (6.26E*1-1. 299EO* GW ♦6.886 E-1*GN**2)  ♦ 

. (-1.0004E*2*2.0317E*1*GN-9.67E-1*GN**2)  *IOF* 

. (1.30368E*1-2.689*GW*1. 403E- 1*GN**2) *T0F**2 

FGR=  ( (-3.3E-1*1.047*GR-8.  57E-4*GR**2)  - 
. (4. 22E-2+9.47E-3*GR*1.9898E-5*GR) *WS) *100. 

GC  TC  100 

33  TCF=(6.6742857E-1+4.4226786E-2*PA) ♦ 

. (1. 027143E-2*3.051339E-4*PA) *T* (1.  74994E-4*5. 023E-7 *PA) * 1**2 

GR= (-1. 37666666 E+ 1*1. 679166666*GKJ ♦ (-3. 55*4. 71875E- 1*GW) *TOF 
FGR= {GR-(1. 5166666666E-l4l.0083333333E-c*GR) *NS) *100. 

GO  TC  100 

34  CONTINUE 

35  CONTINUE 

36  TCF* (-9. 2 083337 E- 1*5.  9 1 1 3 889E- 2* P A) ♦ ( 2 . <9 16  66 E- 2- 2 . 7 7 78E-5* P A) * 7 
GR=  (3.711 17  6E+ 1-1. 640279E ♦ 1*GW*2 . 22609*GW**2j  ♦ 

. (-2. 09922 E + 1*8. 6991 796*GW-8.4586E- 1*GH**2) *TOF* 

. (2. 246949-9. 093486E-1*GF*1.061975E-1*GW**2) *TOF**2 

FGR= (GR- (4.  3358 E- 2*2.  196E-2*GP) *NS* 

(8.79209E-4*8.21219E-5*GR>  *WS**2) *100. 

GC  TO  100 

37  TCP* (-6. 46E-1*6.7857E-2*PA*2. 7 23E -4*P A**2) ♦ 

. (3.69E-2-2.24B-3*PA*3.49E-5*PA**2) *T* 

. (1.07E-4*3.85E-5*PA-4.688E-7*PA**2) *T**2 

GB  = (5.38-1.  105 *GW*1. 14E-1*GW**2)  ♦ 

(8.02E-1-2.57E-1*GW*2.4F-2*GH**2) *TOF 
FGR=(GF-(1.6E-2*2.44E-2*GR-2. 128E-4*GR**2)*WS) *100. 

GC  TC  100 
100  RRDIST=FGR 
RETURN 
END 
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FUNCTION  SIGY 
(ENTRY:  SIGCY) 


Purpose : 

To  compute  the  horizontal  dispersion  coefficient  in  meters,  or 
at  entry  SIGCY,  to  confute  the  virtual  distance  corresponding  to 
the  initial  horizontal  dispersion. 

Input : 

1.  Entry  SIGY  - time  of  travel  in  hours 

2.  Entry  SIGCY  - horizontal  dispersion  in  meters 

3.  Stability  class  and  wind  speed 

Output : 

1.  SIGY  = horizontal  dispersion  in  meters 

2.  SIGCY  = virtual  distance  in  meters 
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FUNCTION  Sir-Y  (.3  ."HOUR) 

THIS  FUNCTION  COMPUTES  THE  HORIZONTAL  DISPERSION  COEFFICIENT 
C IN  METERS 

C 

COMMON  /V’lUN/  VSAVE 
DIMENSION  A (6)  , R (6)  ,C  (6)  ,D  (6) 

DATA  A/2 .1511,1.5454, 1 . 0606 ,. 6 8465 ,. 5936 6, . 59366/ 

DATA  B/. 87326, . 88261, . 890 3 1 , . 88866 , . 891 38 , . 8 9 1 38/ 

DATA  C /212.  , 155.  , 100.  ,68. ,50. ,34./ 

DATA  D/0.89,  0.91,0.92,0.93,0.90,0.9  3/ 

C 

TSFC=THOUR* 7600 . 

SIGY= (A(J) *TSEC**B(J) ) *0.87 
XX  = VJSAVE*THOMR*3. fc 
SIGXY  = C (J) * ( XX* *D  (J) ) *1 .43 
SIGY  = AMAX1  (SIGY, SIGXY) 

RETURN 

ENTRY  STGCY  t J , S IG YO) 

C 

C AT  THIS  ENTRY  THE  DISTANCE  OR  TRAVEL  TIME  CORRESPONDING  TO  THE 
C INPUT  VALUE  OF  THE  HORIZONTAL  DISPERSION  IS  CALCULATED  AND 
C RETURNED  AS  DISTANCE  IN  METERS 
C 

TSEC=EXP(ALCG  (STGYO/ (A  (J) *0.87) ) /B (J) ) 

X=TSEC*WSAVF 

X X = F X P (A. LOG  (SIGYC/  (C  (J)  * 1 . 43)  ) /D  (J)  ) * 1000  . 

S IGC Y = AM  IN  1 (X,XX) 

RFTURN 

END 


SIG  Y000C 
SIGYOOO  1 
SIG Y0002 
SIGYOOO  3 
SIGYOOO  4 
SIG Y0005 
SIGY0006 
SIG Y0007 
SIGYOOO  8 
SIGY0009 
SIGY0010 
SIGY001 1 
SIGY001 2 
SIG Y00  1 3 
SIG Y0014 
SIGYOO  1 5 
STG Y0016 
SIGY001 7 
SIGY0018 
SIG Y001 9 
SIGY0020 
SIGY0021 
SIGY002  2 
SIG  Y 002  3 
SIG Y0024 
SIGY0025 
SIG Y0026 
SIGY0027 
SIGY0028 
SIG Y0029 
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FUNCTION  SIGZ 
(ENTRY:  SIGCZ) 


Purpose: 


&L, 


To  compute  the  vertical  dispersion  coefficient  in  meters,  or  at 
entry  SIGCZ,  to  compute  the  virtual  distance  corresponding  to 
the  initial  vertical  dispersion. 


Input: 


Output: 


1.  Entry  SIGZ  - time  of  travel  in  hours 

2.  Entry  SIGCZ  - vertical  dispersion  in  meters 

3.  Stability  class  and  wind  speed 

1.  SIGZ  = vertical  dispersion  in  meters 

2.  SIGCZ  = virtual  distance  in  meters 


Li: 


FUNCTION  SIGZ 
ENTRY:  SIGCZ 


non 


i 


FUNCTION  SIGZ (J f^HOUR) 

THIS  FUNCTION  COMPUTES  THE  VERTICAL  DISPERSION  COEFFICIENT 
IN  METERS 

COMMON  /'JDUN / WSAVE 

DIMENSION  C(3,6) , D{3,6) ,A(6,6) ,B(6,6) , CK(6,6) 

DIMENSION  TIMF (6) 


DATA  TIMF/  30 0. , 1 000 ., 3000.  , 10000 
Data  A/.  IT  122,  . 27666, . 4 12 1 9, . 5 1 92 1 , 

1 . 1 1062, . 39053, .41219,.  57145, 

2 .01339, . 16640, .41219,1 .0813, 

3 .0  1338, . 16640, .41219,2. 2830, 

3 .0  1338, . 16640, .41219,2.3333, 

3 .01338,. 16640, .41219,5. 6801, 

DATA  B/1 .2098,1.0572,. 92365, . 84130, 

1 1 . 2864, . 99275, .92365, . 82449, 

2 1.5922, 1.1195, .92365, .73217, 

3 1 . 5922, 1 . 1195, . 9236 5 ,. 63883 , 

4 1.5922,  1 . 1195, . 92365,.  63646, 

5 1 . S922, 1 . 1195, .92365, .55016, 
DATA  C/470. ,47  0. ,47  0. , 1 10. , 110. , 110 

. 21. 5, 21. 5,  36.  , 14.  , 14  . ,23.  5/ 

DATA  D/1 .67, 2.  1 3,2.  13,  1.  , 1 .09,  1 .09, 
. 0.70,0.56,0.35,0.78,0.53,0.30/ 

DATA  CK/ 


.,30000., 172000./ 

.50963, .47639, 

.76485, .71936, 

1.9467,2.3901  , 

2.9850, 3. 8684, 

5.7990,16.897, 

14.599,64.577/ 

.79689, .76308, 

.72571 ,.69082, 

.59047, .51700, 

.53708, .45686, 

.46497, .29621, 

.37541 ,. 16667/ 

.,60. ,60. ,60. ,33. ,33. ,40.  , 

0.92,0.92,0.92,0. 80,0.61,0.53, 


SIGZ  000  0 
SIGZ0001 
SIGZ0002 
SIGZ000 3 
SIGZ0004 
SIGZ0005 
SIGZ000  6 
SIGZ0007 
SIGZ0008 
SIGZ0009 
SIGZ001 0 
SIGZ001 1 
SIG  ZO0 1 2 
SIGZ001 3 
SIGZ001 4 
SIGZ001 5 
SIGZ0016 
SIG  ZO0 1 7 
SIGZOO 1 8 
SIG  ZO0 1 9 
SIGZOO  2 0 
SIGZ002 1 
SIGZ0022 
SIGZ002  3 
SIGZ0024 
SIGZ0025 


1 

170.  , 

115., 

80.  , 

6 3., 

48.  , 

37., 

SIGZ0026 

2 

800., 

3 80.  , 

243.25, 

170., 

115., 

85., 

SIGZ0027 

3 

4600.  , 

1300.  , 

671  . , 

380., 

220.  , 

15C . , 

SIGZ0028 

4 

31279., 

5002.  , 

2040.32, 

820., 

420., 

260.  , 

SIGZ0029 

5 

179855.2 

, T71  11  . 38,5628.47, 

1 650., 

700.  , 

358.  , 

SIGZ0030 

6 

2900444 . 

,120972.5,28241.86 

,4312. 55 

, 1 348.32, 

481. 58/ 

SIGZ003 1 

TSEC=THni1P*3600. 

DO  10  N=  1 , 6 

IF(TSEC.LS.TIME(N)  ) GO  TO  20 
10  CONTINU* 

N = 6 

TIME  OF  TRAVEL  SHOULD  BE  LESS  THAN  172000  SEC.  OR  APPROX.  2 DAYS 
20  CONTINUE 

STGZ=  (A  (J  , V)  *TSEC**B  ( J , N)  ) 

XX  = WSA.VE*THO'JR*3.  6 
1=1 

T F (XX  . GT.  1 . ) 1=2 

TF(XX.GT. 10.)  T = 3 

CONVERTS  FROM  A 10  TO  20  MIN.  SAMPLING  TIME 

1.1487  = 2**. 2,  THE  1/5  POWER  LAW  ONLY  APPLIES  UP  TO  20  MIN. 
SAMPLING  TIMES 

STGTZ*  (C (I, J )*XX**D(I,J  ) ) * 1 . 1 487 
SIGZ=  A H AX  1 (SIGZ , SIGTZ) 

RETURN 

ENTRY  SIGCZ  (J, SIG) 

AT  THIS  FNTRY  THE  DISTANCE  OR  TRAVEL  TIME  CORESPONDING  TO  THE 
INPUT  VALUE  OF  THE  VERTICAL  DISPERSION  IS  CALCULATED  AND 
RETURNED  AS  DISTANCE  IN  METERS 

DO  110  N=  1, 6 


SIGZ0032 
SIG  ZOO  3 3 
SIGZ0034 
SIGZ0035 
SIGZ0036 
STGZ0037 
SIG  ZO 03 8 
SIGZOO  39 
SIGZ004  0 
SIGZ004 1 
STGZ004  2 
SIGZ004  3 
SIGZ004  4 
SIGZ0045 
SIGZ004  6 
SIGZ0047 
SIGZ  004  8 
SIGZ004 9 
SIGZ0050 
SIGZ005 1 
SIGZ0052 
SIGZ0053 
SIGZ90S4 
SIGZ0055 
SIGZ0056 
SIG7.0057 
SIGZ005B 
SIGZ0059 
SIGZ0060 
SIGZ006 1 
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IF  (SI6 . L E . CK  ( J , N)  ) GO  TO  120 
1 10  CONTINUE 
N = 6 

120  CONTINUE 

TSEC=EXP (ALOG (SIG/A (J, N) ) /8  (J, ») ) 

SIGXZ  = TSEC*’*SRVE 

TS 1 = C ( 1 , J) * 1 • 1481 

TS2=C  (2 , J) *10. **D  (2, J) *1. 1487 

1 = 3 

IF  (SIG.I.T.TS2)  1 = 2 
IF  (SIS.LT. TS1)  1=1 

SIGCZ=BXP (ALOG ( SIG/ (C  (I ,J) * 1.  1 487) ) /D  (I , J) ) *1000 . 
SIGCZ=ANIN1  (SIGCZ , S IGX  Z) 

RFTORN 

END 


SIGZ0062 
SIGZ006  3 
STGZ006  4 
SIGZ006  5 
STGZ0066 
SIGZ0067 
SIGZ006  8 
STGZ0069 
SIGZ0070 
SIGZ007  1 
SIGZ0072 
STGZ007  3 
SIGZ0074 
91020075 
SIGZ0076 
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SUBROUTINE  SOURCE 


To  position  the  master  source  tape  to  read  the  airbase  and 
environ  source  inventory  data  and  to  call  the  subroutines 
which  confute  the  emission  rates  in  micrograms  per  second 
at  tne  airbase  and  environ  sources. 


JF) AG,  a parameter  to  indicate  whether  the  diurnal  distri- 
bution used  is  input,  default  or  the  same  as  previous  hour. 


A statement  indicating  the  diurnal  distribution  used. 


ABPTAR,  ABARAR,  ABLNAR,  ENARAY 


SUBROUTINE  SOURCE 

SOU  RCOO  1 
SOU  RC  002 

I HIS  ROUTINE  SERVES  AS  A DRIVER  TO  CALB  SUBROUTINES 

SOURC00  3 

WHICH  COMPUTE  THE  EMISSION  RATES  IN  MICROGRAMS 

SOURC004 

PER  SECOND  AT  THE  AIRBASE  AND  ENVIRON  SOURCES 

SOUFC005 

SOURC006 

COMMON  / DEFALT  / ITAPE 

SOU  RCOO  7 

COMMON  /PERIOD/  IMONT H , NOD AY S , ID AY , IHR 1 , IHR 2, IFL AG, JFLAG, 

IONCE  SOURC008 

CCMMCN/JUNK/DA Y S,LSRCE,NSRCE,SORCE(17,300) , SORGM (10,200) 

SOU  RC009 

. ,LCC1,LOC2,NGEOM,IPT 

SOURC0  10 

DIMENSION  NAME  (2) 

SOURC0  1 1 

DATA  NAME  /4H1/12.4H1  / 

SOU  RCG 1 2 

IF  (ICNCE.EC.C)  GO  TO  30 

SOUFCOI 3 

IEND= 1 

SOU  RCO  1 4 

ISI=1 

SOUPCO  1 5 

GO  TO  40 

SOU  RC0 1 6 

30 

IEND=0 

SOU  ECO  1 7 

ICNCE= 1 

SOURCO 1 8 

IST  = C 

SOU  RCO 1 9 

40 

CONTINUE 

SOU  PC  02  0 

DA Y S = NODAY  S 

SOU  RCO  2 1 

IF  (1ST. EC. 1)  GO  TO  3 

SOURC022 

1 

FORMAT  (14) 

SOURC023 

READ  1,  JELAG 

SOU  RCO  24 

IE  (JF1AG)  8,7,3 

SOU RCO 2 5 

7 

PFINT  5 

SOURC026 

5 

FORMAT (32HCINPUT  DIURNAL  DISTRIBUTION  USED) 

SOU  RCO  27 

GC  TO  4 

SOUFC028 

8 

1 = 1 

SOU  RC029 

IE  (NCDAYS. EQ. 3b5)  1=2 

SOURC030 

PRINT  9,NAME(I) 

SOU  RCO  3 1 

9 

FORMAT  (34H0DEE AULT  DIURNAL  DISTRIBUTION  USED/5X,  12HHOUR  = 

1/24, 5X, SO  U ECO  32 

. 1 OH  LA Y = 1/7,5X,8HMONTH  = A4 , 1 H , 5X, 1 ^H U NIE RC  = 0.1) 

SOURC033 

GC  TO  4 

SOU  RCO  34 

3 

PRINT  6 

SO  U RCO  38 

6 

FORMAT  (39H0DIURNAL  DISTRIBUTION  SAME  AS  LAST  HOUR) 

SOU  RCO  36 

GC  TO  10 

SOURCO  37 

4 

IE  (IEND.EC. 0)  GO  TO  12 

SOURCO  38 

11 

READ  (ITAPE, END=12) 

SOU  RCO 39 

GC  TO  11 

SOURC  04  0 

IENL=  1 

SOU  RCO  4 1 

CALL  ABPTAE 

SOU  RC04  2 

CALL  AEARAR 

SOURC  04  3 

CALL  ABLNAE 

SOU  RC044 

CALL  ENARAY 

SOURC045 

10 

REWINE  ITAPE 

SOU  RC046 

RETURN 

SOURC047 

END 

SOU  PCO  4 8 

SUBROUTINE  STPOL1 


Purpose: 

To  calculate  pollutant  concentrations  from  point  and  area  sources. 


Input : 

1.  Location  and  conditions  at  point  or  area  source 

2.  Location  of  receptors 

3.  Meteorological  conditions 

Output : 

Concentration  of  pollutants  at  each  receptor 


Procedure : 

1.  For  area  sources  determine  average  diameter, 
effective  stack  height,  and  initial  values  of 
horizontal  and  vertical  dispersion.  Also  consi- 
der effects  of  downwash  on  these. 

2.  For  point  sources  determine  plume  rise  by  calling 
PLRISE. 

3.  Consider  effects  of  wind  speed  at  height  of  source. 

4.  Calculate  crosswind  and  downwind  components  for 
the  source. 

5.  Calculate  time  required  for  plume  to  travel  from 
virtual  point  source  to  actual  location  of  true 
source  by  PSEUDO  routine. 

6.  For  each  receptor,  calculate  crosswind  and  down- 
wind components. 

7.  Consider  the  relative  location  of  receptor  with 
respect  to  source  and,  if  necessary,  calculate 
coupling  coefficient  using  TRAN  routine. 

8.  For  each  pollutant,  add  in  concentration  determined. 


Subroutines 

Called: 

PLRISE,  PSEUDO 


Function 

Called: 

TRAN 
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SIGYIN  = DELY/2.4 
SIGZIN  = DELZ/2.4 
HEFF  = 2*ZS 
KSTAB  = 0 


SUBROUTINE  STPOL1 


TREAT  AS  POINT 
SOURCE:  SET 
PRFLAG  = 0 


CALL  PLRISE  TO  CALCULATE 
HORIZONTAL  AND  VERTICAL 
DISPERSION,  SIGYIN,  SIGZIN, 
AND  EFFECTIVE  HEIGH,  HEFF 


t*  2.68 
— 

2.68 


DOWNWASH  OCCURS, 
ADJUST  HEIGHT  AND 
VERTICAL  DISPERSION: 
HEFF  = ZS 

SIGZIN  = MAX  (SIGZIN, 
HEFF/1.2) 


ADJUST  XMJLF  FOR 
TRANSPORT  WIND  SPEED  AT 
EFFECTIVE  SOURCE  HEIGH 


CALCULATE  CROSSWIND  AND 
DOWNWIND  COMPONENTS  FOR  SOURCE: 
CWS  = XS*COS(WD)  -YS*SIN(WD) 
DWS  ■ -XS'SENCWD)  -YS*COS(WD) 


ADJUST  WIND  SPEED: 
WSMD  = WSaXMJLF 


CALL  PSEUDO  TO  CALCULATE 
TRAVEL  TIMES  TY  AND  TZ  AND 
CONVERT  TO  HOURS 


UUUU  UUUUOUU  <j  U U U U U U U U U (J  U U O U O o 


SUBROUTINE  STP0L1 


THIS  BOOTIHE  CALCULATES  POLLUTANT  CONCENTRATIONS  FROM  POINT  AND 
AREA  SOURCES 

CCHHON  /HEX/  NS , WSHPH f IBS , «Df IND, SINEND, COS  END, JSTAB, HLID, TE HF, 

. IEHK 

COHHCN  /BCPT/  NRECEP, RECEP  (2, 312) 

CCHHON  /INFO/  IBECEP, INNDIB, ITIPE  , HTAEBO , XS , IS , ZS, DELY , DELZ , 
. IS,VS,DS,HB,PRFLAG,EHIS(8) ,NPOL 
CCHBCN  /AIRQAL/  RECDAT  (3,  6,312) 

COHHCN  /XTBAN/  XL, NSH D,TY ,TZ 
COHHCN  /LOC/  DH ,CH , ZR , HIT 
COHHON  /NNDPRO/  XP (6) 

DATA  SIGHIN  /2. 083333/ 

XHO IF  * 1.0 

PRFLAG  LESS  THAN  0.0  INDICATES  AN  AREA  SOURCE 
IF  (PBFLAG.GE.0.0)  GO  TO  5 

IF  DELY  IS  LESS  THAN  50  HETEBS,  TREAT  SOURCE  AS  A POINT  WITH 
NO  ELUHE  RISE 

IF  (DELY.LE. 50. ) GO  TO  4 
KSTAB  = 0 

SIGYIN  = DELY  / 2.4 

HEFF  = 2. *ZS 

SIGZIN  * DELZ/ 2 . 4 

IF  (NS  .LE.  2.68)  GO  TO  10 

DONNHASH  OCCURS,  ADJUST  HEIGHT  AND  VERTICAL  DISPERSION 
HEFF  = ZS 

IF  (HEPF/1.2  .GT.  SIGZIN)  SIGZIN  = HEFF/1.2 
GC  TC  10 

4 PRF  LAG  = 0 . 

5 CALL  ELBISE  (HEFF, KST AB, S IGZIN , SIGYIN) 

IF  (PRFLAG. EQ. 0.0)  GO  TO  10 

JJJ  * JSTAB 

IF  (KSTAB  .GE.  1)  JJJ=5 
HEFL=AHIN1  (HEFF, 305.) 

ADJUST  XHULF  FOR  TRANSPORT  BIND  SPEED  AT  EFFECTIVE  SOURCE  HEIGHT 

IF  (HEFL  .GT.  HTAEBO)  XHULF* (HEFL/HTAERO) **XP (JJJ) 

CALCULATE  CBOSSHIND  AND  DOHNNIND  COHPONENTS  FOR  SOURCE 

10  CNS  * XS*COSEND  - YS*SINEND 
DBS  = -XS*SINEND  - YS*COSEND 

ADJUST  BIND  SPEED 

NSHD  = NS  * XHULF 

IF  (SIGYIN.LT.  SIGHIN)  SIGYIN  * SIGHIN 
IF  (SIGZIN.LT.  SIGHIN)  SIGZIN  * SIGHIN 

CALCULATE  TRAVEL  TIRES  TO  PSEUDO  UPHIND  POINT  SOURCE.  TY  AND  TZ 
ARE  RETURNED  AS  DISTANCES  IN  HETERS  AND  CONVERTED  TO  EQUIVALENT 
TIHES  IN  HOURS 


STPL1000 
STPL1001 
STPL1002 
STPL1003 
STPL1004 
STPL1005 
STPL1006 
STPL1007 
STPL1008 
STPL1009 
STPL1010 
STPL10 1 1 
STPL1012 
STPL1013 
STPL1014 
STPL1015 
STPL1016 
STPL101 7 
STPL1018 
STPL1019 
STPL1020 
STPL1021 
STPL1022 
STPL1023 
STPL1024 
STPL1025 
STPL1026 
STPL1027 
STPL 1028 
STPL1029 
STPL1030 
STPL1031 
STPL  1032 
STPL 1033 
STPL1034 
STPL1035 
STPL 1 0 36 
STPL 1 037 
STPL 1038 
STPL 1 0 39 
STPL 1040 
STPL 1 04 1 
STPL 1 04  2 
STPL1043 
STPL 1 044 
STPL1045 
STPL  1046 
STPL 1 047 
STPL 1048 
STPL1049 
STPL1050 
STPL 1051 
STPL 1052 
STPL 1 05  3 
STPL 1054 
STPL 1 055 
STPL 1 056 
STPL1057 
STPL 1058 
STPL1059 
STPL1060 
STPL 106 1 
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on  non  n n n n n non  non  non  n n n n n n n n n n non  non 


I 


CALL  PSEUDO  (S IG YIN , WSH D, S IGZI N,TY ,TZ) 

TY=TY/HSMD/3600. 

TZ=TZ/HSHD/3600. 

ZB  = 2. 

BEGIN  RECEPTOR  LOOP 
DC  2C  NB= 1 , NRECEP 

HIT  IS  RADIOS  Of  SOORCE  IN  KILOMETERS 
KIT  = 1.2  * SIGYIN  / 1000. 

CALCULATE  CROSSNIND  AND  DOHNHIND  COMPONENTS  OF  RECEPTOR  AND 
CONFUTE  DISTANCES  IN  KILOHETERS  FRON  RECEPTOR  TO  SOORCE 

CHR  = RECEP <1, NR) *C0SHHD  - RECEP (2, NR) *SINEHD 
CH  = CHR  - CHS 

DBF  = -RECEP (1 , NR)  * SINEBD  - RECEP(2,NR)  * COSEND 
DB  = DHR  - DBS 

PFA  IS  FRACTION  OF  TOTAL  AREA  SOURCE  BEING  TREATED 

IF  (DH . LE . -HIT)  GO  TO  20 

IS  EECEETOR  UPWIND  OF  SOURCE? 

PFA  = 1.0 

NBFLAG=0 

IBACK=0 

IF  (PRFLAG.GF.0.0)  GO  TO  16 
IS  RECEETOR  INSIDE  SOORCE? 

IF (DH.LE. HIT)  GO  TO  15 

IS  CRITICAL  DISTANCE  DOHNHIND  OP  DOHNHIND  EDGE  OF  SOURCE? 

IF ( (DHR-XL)  .GE.  (DHS  + HIT) ) GO  TO  16 
IS  CRITICAL  DISTANCE  UPHIND  OF  UPWIND  EDGE  OF  SOURCE? 

15  IF ( (DHR-XL)  .LT.  (DHS-HIT) ) GO  TO  17 

CRITICAL  DISTANCE  IS  INSIDE  SOORCE.  REDEFINE  PFA,  DH  AND  HIT 
FCR  TRAN  FUNCTION  TO  CONSIDER  ONLY  THE  PORTION  OF  SOURCE 
UPHIND  CF  THE  CRITICAL  DISTANCE 

PFA= (DH-XL+HIT)/(2.*HIT) 

DHSS= ( (DHS-HIT) ♦ (DHR- XL) ) /2. 

DH=DHR-DHSS 
HIT=DH-XL 
IBACK=1 
GC  TC  16 
17  NRFLAG=1 
FFA  = 1 . 

CALL  TRAN  FUNCTION  TO  DETERMINE  COUPLING  COEFFICIENTS 

16  CUFCOE  = TRAN  (KSTAB, HEPF , NRFL AG , IB ACK  ) * PFA 

ADD  EMISSIONS  TINES  COUPLING  COEFFICIENT  TO  CONCENTRATIONS 


STPL1062 
STPL1063 
STPL1064 
STPL1065 
STPL1066 
STPL1067 
STPL1068 
STPL1069 
STPL1070 
STPL1071 
STPL1072 
STPL1073 
STPL 1 074 
STPL1075 
STPL1076 
STPL1077 
STPL1078 
STPL 1079 
STPL1080 
STPL 1 08 1 
STPL 1082 
STPL1083 
STPL1084 
STPL1085 
STPL1086 
STPL 1 087 
STPL 1 088 
STPL 1 089 
STPL 1 090 
STPL 1 09 1 
STPL1092 
STPL 1 09  3 
STPL 1 094 
STPL 1095 
STPL 1096 
STPL 1 097 
STPL1098 
STPL 1 099 
STPL1100 
STPL  1101 
STPL1 102 
STPL1 103 
STPL1 104 
STPL1 105 
STPL1106 
STPL1 107 
STPL1  108 
STPL1 109 
STPL1 110 
STPL1111 
STPL 11 12 
STPL 1113 
STPL1 114 
STPL1 115 
STPL1 116 
STPL1  117 
STPL 1118 
STPL1 119 
STPL1 120 
STPL1 121 
STPL1 122 
STPL1 123 
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AT  ILL  RECEPTORS 

DO  18  IPOL  ■ 1 , HPOL 
9 RECDAT  (ITTPE, IPOL, NR) 
IF  (IBACK. EQ. 1)  GO  TO 
20  CONTINUE 
RETORN 
END 


* RECDAT (ITTPE, IPOL, MR)  ♦ EMIS  (IPOL) 


STPL1 124 
STPL1 125 
STPL1126 
♦COPCOESTPL1 127 
STPL1 128 
STPL1 129 
STPL1 130 
STPL1131 


SUBROUTINE  STPOL2 


I 


Purpose: 


l | 

Input : 


Output : 


Procedure : 


I; 


To  prepare  the  data  required  by  the  line  source  model  and,  for 
each  receptor,  to  call  the  model  and  then  add  the  pollutant 
concentrations  calculated  to  the  accumulated  totals  at  that 
receptor . 

1.  Source  parameters  for  the  current  line. 

2.  Wind  speed  and  direction,  and  lid  height. 

Accumulated  pollutant  concentrations  at  all  receptors. 

1.  Convert  source  data  to  correct  units. 

2.  Calculate  variables  used  by  the  line  source  model. 

3.  For  each  receptor,  call  the  line  source  function  and 
accumulate  the  concentrations  by  receptor,  pollutant, 
and  source  type. 


Subroutines 

Called: 

PSEUDO  ,AINE 


Ll 


X 


SET  VARIABLES  FOR  CAVL: 

XWl=YWT-0. 0 

ZW1=MIN(Z1,Z2) 

ZW2=MAX(Z1,Z2) 


TIMEO=TIME 

k 

■> 

< HLID 
S 

Lfi, 

FIND  THE  X AND  Y 
COORDINATES  OF 
THE  POINT  WHERE 
THE  LINE  GOES 
THRU  THE  LID 


ZW2=HLID 


RECALCULATE  DL  AS 
THE  LENGTH  OF  THE 
LINE  UP  TO  HLID 
AND  CHANGE  VI, 
V2  AND  TINE 
ACCORDINGLY 


V12=V1*V1 


START  RECEPTOR  LOOP 


CALL  AINE  TO  FIND 
CCNC  AND  ADD  THE  POLLUTANT 
CONCENTRATION  EMISSION 
RATE  MODIFIED  BY 
TIME/TINEO  TO  THE  RE  COAT  ARRAY 


END  RECEPTOR  LOOP 


AR60NNE  NATIONAL  LAB  ILL 

AIR  QUALITY  ASSESSMENT  MODEL  FOR  AIR  FORCE  OPERATIONS 
APR  77  D J BIN6AMAN 

CEE00-TR-76-34 


F/6  13/2 
SHORT-T — ETC (U) 


SUBROUTINE  STP0L2 

THIS  SUBROUTINE  PREPARES  DATA  REQUIRED  BI  THE  LINE 
SOURCE  HODBL  AND  CALLS  THE  HODEL  TO  DETERHINE  THE  POLLUTANT 
CONCENTRATIONS  AT  ALL  RECEPTORS 

COHHON  /RET/  NS , NSHPH ,IWS , HD, IND, SINEWD, COSEND, JSTAB, HLID, TEHP, 
. TEHK 

CCRHCN  /RCPT/  NRFCEP, RECEP  (2, 312) 

COHHON  /AIRQAL/  RECDAT  (3,  6,312) 

COHHON  /INFO/  IRECEP, IVNDIR, ITT PE, HTAERO, X 1 , II , Z 1 , N , DELZ , X2, Y2, 
. V1,V2,DL,TIHE,EHIS(6) , NPOL 

COHHON  /LN/  XN1 , YH1 ,Z W1 , XN2, IW2, ZN2, SUDOT , SUDOZ, I AD , T AIL, A , V 12 , 
. NS2, NSC, RR, SP 

CONVERT  SOURCE  DATA  TO  PROPER  UNITS 

TIHE  = TIHE  * 3600. 

IF<TIHE.LE.O. 1)  GO  TO  11 
XI  = XI  * 1000. 

Y 1 = Y 1 * 1000. 

X2  = X2  * 1000. 

Y2  = Y2  * 1000. 

VI  = VI  / 3.6 
V2  = V2  / 3.6 

CALCULATE  VARIABLES  USED  BY  THE  LINE  SOURCE  HODEL 

Dt=SQRT  ( (X2-X1) **2* (Y2-Y1) **2  + (Z2-Z1) **2) 

IAD  = 0 

II  (VI  .LT.  (V2-.01))  IAD  * 2 
IF  (VI  .GT.  (V2+ .01) ) IAD  = 1 
TIHE  = ABS (2*DL/ (V1+V2) ) 

A = (V2  - VI)  / TIHE 
NS2  = IS  MS 
TAIL  = 1«0. 

N = B / 2.4 
DELZ  = DELZ  / 2.4 

CALL  PSEUDO  (N, NS, DEL Z , SUDOY, SUDOZ) 

SDDOY  AND  SUDOZ  ARE  RETURNED  IN  HETERS 

XN1=0. 

YN1 =0 . 

ZN1*Z1 

ZN2=Z2 

IF  (Z 1 . LE. Z2)  GO  TO  15 

ZW1*Z2 

ZN2*Z1 

15  TIHEO=TIHE 

IF (ZH2 .LE. HLID) GO  TO  18 

FIND  POINT  WHERE  THE  LINE  GOES  THRU  THE  LID 
AND  CHANGE  THE  COORDINATES 

F=(HLID-ZW1)/(ZW2-ZW1) 

IF  (Z1  .GT.  Z2)  GO  TO  16 
X2=XU  (X2-X1)  *F 
Y2=Y1*  (Y2-Y1)  *F 
GC  TC  17 

16  X1=X2*  (X1-X2)  *F 
Y 1 =Y2*  (Y1-Y2)  *F 


STPL2000 
STPL200 1 
STPL2002 
STPL2003 
STPL2004 
STPL2005 
STPL2006 
STPL2007 
STPL200B 
STPL2009 
Z2 , STPL20  10 
STPL201 1 
VS , STPL20 1 2 
STPL201 3 
STPL2014 
STPL20 1 5 
STPL2016 
STPL2017 
STPL20 1 8 
STPL20 1 9 
STPL2020 
STPL20  2 1 
STPL202  2 
STPL202  3 
STPL2024 
STPL2025 
STPL2026 
STPL2027 
STPL20  28 
STPL2029 
STPL2030 
STPL2031 
STPL2032 
STPL2033 
STPL2034 
STPL20  35 
STPL2036 
STPL2037 
STPL20  38 
STPL2039 
STPL2040 
STPL204 1 
STPL204  2 
STPL204  3 
STPL2044 
STPL2045 
STPL204  6 
STPL2047 
STPL2048 
STPL2049 
STPL2050 
STPL205 1 
STPL205  2 
STPL205  3 
STPL2054 
STPL2055 
STPL2056 
STPL2057 
STPL2058 
STPL2059 
STPL2060 
STPL206 1 
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SE 


17  Z«2  = HLID 

RECALCULATE  THE  LENGTH  OF  THE  LINE  UP  TO  HLID  AMD 
CHANGE  VELOCITIES  ACCORDINGLY 

DLSQ  = (K1-X2) **2  ♦ (Y1-Y2) **2  ♦ (ZH1-ZB2)**2 
DL  = SQRT  (DLSQ) 

IF  (Z2  .GT.  Z1)  V2  = SQRT <V1*V 1+2 . *A*DL) 

IF  (Z2  .LT.  Z1)  VI  = SQRT (V2*V2-2 .* A* DL) 

TIHE  = 2*  DL  / (V1+V2) 

18  V 12  = VI  * VI 

CALL  THE  LINE  FUNCTION  TO  DETERMINE  POLLUTANT  CONCENTRATIONS 
AT  ALL  RECEPTORS 

DO  10  IRECEP~1,NRECEP 
CCNC  = AI NE  (HD) 

DO  10  I POL3 1 , NPOL 

10  RECDAT  (ITT PE , I POL, IR ECEP)  = R EC DAT (ITYPE, IPOL, IRECEP)  ♦ 

- EHIS(IPOL)  * CONC  * TIHE  / TIHEO 

11  CCNTI HUE 
RETURN 
END 


STPL2062 
STPL2063 
STPL2064 
STPL2065 
STPL2066 
STPL2067 
STPL2068 
STPL2069 
STPL2070 
STPL2071 
STPL207  2 
STPL207  3 
STPL2074 
STPL2075 
STPL2076 
STPL2077 
STPL2078 
STPL2079 
STPL2080 
STPL2081 
STPL2082 
STPL2083 
STPL2084 
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FUNCTION  TRAN 


Purpose: 

To  calculate  the  coupling  coefficient  at  a receptor  due  to  a 

point  or  area  source. 

Input: 

1.  Meteorological  conditions:  wind  speed,  stability,  mixing 
height,  critical  distance  for  mixing. 

2.  Source  parameters:  initial  horizontal  and  vertical  disper- 
sion; effective  stack  height;  pseudo  transport  times 
corresponding  to  the  dispersions;  plume  height  flag, 

KSTAB;  area  source  flags,  NRFLAG  and  IBACK. 

Output : 

Point  or  area  source  coupling  coefficient,  TRAN. 

Procedure : 

1.  If  the  effective  stack  height  exceeds  the  mixing  height, 
then  the  stability  index  is  reassigned  according  to  the 
KSTAB  flag,  the  lid  is  set  at  3050  meters  and  the  critical 
distance  at  100  meters. 

2.  For  sources  with  NRFLAG=0 , compute  the  travel  time  for  z 
dispersion  from  the  center  and  that  for  y dispersion  from 
the  downwind  edge  of  the  source.  Then  the  effects  of 
ground  and  sky  lid  are  treated  by  the  image  method,  with  up 
to  6 terms  included  in  the  coupling  coefficient. 

3.  For  area  sources  with  NRFLAG=1 , the  travel  times  from  the 
upwind  and  downwind  edges  of  the  source  are  determined  on 
the  basis  of  receptor  location  relative  to  the  source. 

These  plus  the  pseudo  travel  time,  TZ,  due  to  the  z spread 
are  used  to  compute  the  z-dispersion  coefficients  oz  (Tl) 
and  az  (T2).  The  y-dispersion  coefficient  ay  (TT)  is 
determined  on  the  basis  of  the  pseudo  travel  time,  TY , due 
to  the  y-spread  plus  the  travel  time  from  the  downwind  edge 
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Functions 

Called: 


4.  If  the  source  flag  IBACK  is  1,  part  of  the  area  source  is 
to  be  treated  as  "near"  and  part  as  "far"  area  sources. 
When  both  contributions  to  the  coupling  coefficient  are 
computed  and  sunned,  IBACK  is  then  set  to  0. 


SIGY,SIGZ 


to  the  receptor.  Then  the  coupling  coefficient  is  com- 
puted using  the  integrated  expression  for  "near"  source. 


FUNCTION  TRAN  (KSTAB,  HEFF,  NRFLAG,  IBACK) 


TRAN*=0 

IBACK=0 

1 


2 


< TMIX 


m 


- i(  (HEFF-HRECPT) /SZ2) 2 
EXZ1  « e i 

- i(  (HEFF+HRECPT) /SZ2) 2 
EXZ2  - e z 
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FUNCTION  TRAN  ( KSTAB, HBFF, NFFLAG, I BACK) 

THIS  FUNCTION  CALCULATES  THE  COUPLING  COEFFICIENT 
AT  A RECEPTOR  DUE  TO  A POINT  OR  APEA  SOURCE 

COHHCN  /INFO/  IP ECEP , IN NDIP , ITT PE  , HTAERO, XS , IS , 7S , DELY , DEL7 , 

. TS,VS,PS,UR,PRPLAG,EHIS ( 8),NPOL 
CONNOR  /NET/  WS, WSH PH , IWS , WD, IWD , S INEWD , COSEWD, JSTAB, HHIX,TE»F, 

. TEN!' 

COMMON  /XTRAN/  CL  , WSHD , TY ,TZ 
COMRON/WDUH/WSAVE 
COHHON/LOC/DW,CW ,HRECPT,WIT 
DATA  SQ2PI  /2. 5066283/ 

XL  = CL 
JSTABT= JSTAB 
WSAVE=WSHD 
WSKHPH=WSAVE*3. 6 
DELYKM=DELY/1000. 

ADD1 =0 . 

ADD2=0. 

ADD3=0 . 

ADDU=0. 

ADD5=0 . 

A DD6  = 0 . 

IF  (KSTAB. GT.O)  GO  TO  121 

KST AB  = 0 , PLURE  IS  EELOW  THE  LID,  IF  RECEPTOR  IS  ABOVE 
LID,  TRAN  = 0. 

IF  (HPECPT.GT.HRIX)  GO  TO  76 

HLID=HRIX 

GOTO  140 

ASSURE  ARBITRARILY  HIGH  LID  HEIGHT  FOR  TWO  CASES  WHEN : 

KSTAB  = 1,  PLURE  IS  INITI ALLLY  ABOVE  THE  LID 
KSTAB  = 2,  PLURE  WILL  PENETRATE  THE  LID 
ASSIGN  STABILITY  CLASSES  5 AND  4 RESPECTIVELY 

121  JSTABT-6-KSTAB 
HLID=  3050 . 

XL  = 100. 

140  CONTINUE 

DHIN  = ABS  (CW) 

TT=TY*DW/WSKRPH 
IE  (TT.LE.O.)  GO  TO  76 
IE  (NRELAG. NE.O)  GO  TO  143 

NPFLAG=0,  EFFECTS  OF  GROUND  AND  SKY  LID  ARE  TREAT  FD 
BY  THE  MULTIPLE  IMAGE  METHOD,  WITH  UP  TO  6 TERMS 
INCLUDED  IN  THE  COUPLING  COEFFICIENT 

THIN  *=  0. 

IF  (DW-WIT.GT.O.)  THIN=  (DW-WIT) /WSKMPH 
IF  (IB ACK . EQ.  0)  GO  TO  131 

I BACK= 1 , RECEPTOR  IS  WITHIN  CRITICAL  DOWNWIND  DISTANCE. 

TREAT  PORTIONS  OF  SOURCE  UPWIND  OF  CRITICAL  LENGTH 
FROM  RECEPTOR 

IF  (DW+WIT-DELYKH)  132,132,133 
132  THIN=0. 


TRANOOOO 
TRAN0001 
TRAW0002 
TPAN000  3 
Tp  AN0004 
TRAN0005 
TRAN 00 06 
TRANOO  07 
TRANCOOR 
TR  A»>0009 
"•R  ANODIC 
TR  A*i0O  1 1 
TRAN0012 
TRA.N0C  1 3 
TRANOO 1 4 
TRANOO  15 
Tp ANO0 16 
TRAN0017 
TRANOO 1 8 
TRANOO IP 
TPAN0020 
TRAN0O21 
TP  A N00  22 
TRANOO  23 
,T,RAR0024 
TRAN0025 
TP AN0026 
TR AN0O27 
T.<ANC028 
TPAN0029 
TRANOO  30 
TP  AFOO  31 
TRANOO  32 
TRANOO  33 
TRAN0034 
TRANOO  36 
TRANOO  36 
TRANOO  37 
TRAN0O38 
TRAN0039 
TRANOO  40 
TPAN0041 
TRANOO 42 
TRAK0043 
t>pAN0044 
TRAN0045 
TRAN0066 
TPANC047 
T°AN0048 
TRANOO  49 
TRANPOSO 
TRAN0051 
TPAN0052 
TPANOOS3 
TP ANO0  54 
TPAN0055 
TRAN0066 
’’’RANOO  S7 
TPAN0058 
TRAN0PS9 
TRAN0060 
TRAN0C61 
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GO  TO  131 

133  THIN* (DN+WXT- DEL YKN)  /WSKHPH 
131  TT*AHAX1 (THIN*TY , . 0 1) 

SY=SIGY(JSTABT,TT) 

IBP  * NIT  ♦ DW 

IP  (XBP.LT. 2.*WIT)  DN*  XBP/2. 

TTT=TZ*DN/NSKHPH 
SZ*SIGZ  (JSTABT.TTT) 

ED*DHIN/(SY/1000.) 

EXPD*- • 5*ED*ED 

IP  (EXPO. LT. -20.)  GO  TO  76 

EDS  iiXP  (EXPD) 

IP  (DW.GT.2.*XL)  GO  TO  153 

CALCULATE  HOLTIPLE  INAGES 

DENOH=6.2831853*WSAVE*SY*SZ 

INAGES  1 AND  2:  GHOOND  FEPLECTION  OF  SOUPCE 

Z2=HEFF+HRECPT 
Z1*HEFF-HRECPT 
EXPZ=- (Z1/SZ)  **2/2. 

IP  (EXPZ.LT.-20. ) GO  TO  76 
E 1=EXP (EXPZ) 

ADD1=E1*EDD/DEN0H 
IP  (HEFP.GT.0.0)  GO  TO  171 
ADD2=ADD1 
GOTO  172 

171  CONTINUE 

EXPZ=- (Z2/SZ)  **2/2. 

IP  (EXPZ. LT. -20.)  GO  TO  61 
E2=EXP (EXPZ) 

ADD2=ADD1*E2/E1 

IHAGES  3 AND  4:  REFLECTION  ABOUT  HLID  OP  SOUBCE 

172  CONTINUE 

IP  (HBFP.LE.HLID/2.0. AND.SZ.LT. (HLID-HEFF) /2. 2)  GO  TO  61 
IP  (HEPP. LT. HLID)  GO  TO  174 
ADD3=ADD1 
ADD4=ADD2 
GOTO  173 
174  CONTINUE 

Z=2.*HLID-Z2 
EXPZ=- (Z/SZ) **2/2. 

IP  (EXPZ. LT. -20.)  GO  TO  61 
E3=EXP  (EXPZ) 

ADD3=ADD1*E3/E1 
Z=2.*HLID-Z1 
EXPZ=- (Z/SZ) **2/2. 

IP  (EXPZ. LT. -20. ) GO  TO  61 
E4=EXP  (EXPZ) 

ADD4=ADD1*E4/E1 

IP  (HEPP. GT. 0.0)  GO  TO  173 

ADD5* ADD3 

ADD6- ADDU 

GO  TO  61 

IHAGES  5 AND  6:  REFLECTION  ABOUT  HLID  OP  FIRST  BELOW  GROUND  TNAGE 

173  CONTINUE 


TRAN0062 
TPAN0063 
TEANOO  64 

•’'panooss 
TPAN0066 
TRAN0067 
TRAN0r'68 
TPAN0069 
TRAN0070 
TRAN0071 
TPANOC’2 
TPAN0073 
TRAV0074 
TFAN0075 
TRAN0C76 
TFAN0077 
TRA*'0078 
TRAN0079 
•’'RAN0080 
fR AN008  1 
T°  AN  0 982 

TRAN008R 
"PRW0084 
Tn  SNOO  85 
TRAN008K 
TRAN0CR7 
TRAN0088 
TRAN00«9 
TRANO0°O 
TR*N00Q1 
TFAN0092 
TFAN0093 
TRAN0094 
TRAN009R 
TP  Aw0096 
TPAV0097 
TRANC098 
TPAN0099 
TRAVQ100 
TRAVC101 
n'R  ANO  102 
TPAV0103 
TRA "0 104 
TP  AN0 105 
TR  A NO  106 

TR  AN0 1 07 

TP ANO 1 08 
TRA  N0 109 
TRANC110 
TRAW0111 
TPAN0112 
TRAN01 13 

T^ANOi m 

TRAN0115 
TW AR0 1 16 
TPAN01 17 
TRAWOI  18 
TPAN01  19 
i*R  ANO  1 20 
TPAN0121 
mP  A N0 1 2? 
TRAN0123 
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Z=2 .*HLID+Z1 
EXPZ=-  (Z/SZ) **2/2. 

IF  (EXPZ. LT. -20. ) GO  TO  61 
E5=EXP (EXPZ) 

ADD5=ADD1 *E5/E1 
Z=2. *HLID*Z2 
EXPZ*-  (Z/SZ) **2/2. 

IF  (EXPZ . IT. -20 . ) GO  TO  61 
E6  = EXP  (EXPZ) 

ADD6=ADD1*E6/E1 
GO  TO  61 
C 

C UNIFORM  BIXING  ASSUMED 
C 

153  DENOH=SQ2PI*WSAVE*SY 
ADD1=EDD/ (DENOB*HLID) 

61  CONTINUE 

TRAN=ADD1*ADD2*ADD3*ADD4*ADD5+ADD6 

RETURN 

C 

76  TRAN=0. 

IBACK=0 

RETURN 

C 

C NRFLAG= 1 , RECEPTOR  IS  CLOSE  TO  SOURCE 
C 

143  IF  (IBACK.IJQ.  1)  GO  TO  14« 

C 

C UPWIND  FART  OF  SOURCE 

C 

T2= (DW+WIT) /WSKHPH+TZ 
DWDEDG=DW-WIT 
GO  TO  145 
C 

C DOWNWIND  PART  OF  SOURCE 
C 

144  T2=TZ*XL/WSKHPH 
DWDEDG=DV*KIT-DELYKB 

145  IF  (DWDEDG. LE.O. ) GO  TO  146 
C 

C RECEPTOR  IS  DOWNWIND  . FIND  TRANSIT  TIMES  FROM 
C DOWNWIND  EDGE  OF  SOURCE 
C 

T1=TZ+DWDEDG/WSKMPH 
TT=TY* DWDEDG/ WSKHPH 
7. 1 = SIGZ(JSTABT,T1) 

_Z*'T3Y  (JSTABT,  TT) 


TFAP9124 
TPAN0125 
TRAN0126 
TP ANO 1 27 
TRAN0128 
TRAN0129 
TFANO 130 
TPAN0131 
TFAN0132 
TFAN0133 
TPAW0134 
fRANOI 35 
TPAN01 46 
TRAN 01 37 
TRAN0138 
TFANC139 

TRAN014O 
TPAN0141 
TFA»01 42 
TFAN0143 
TPAN014U 
TRAN01 4^ 
TFAN0148 
TFAN0147 
TRAN0198 
TFANO 1 4° 
TRAN015C 
TP  AN0 1 51 
TFANO 152 
TFAw0 153 
TFAN0159 
’’’F  AN0 1 55 
TRA  N0 1 56 
•NFAN0157 
TN AN0158 
TP  A NO  1 59 
TFANO 160 

TPAROlfii 

TRAN01 62 
TRAN0163 
'’’P  AN01 64 
TFAN0165 
TRAN0166 
TP  AN0 167 
TPAN0168 
TRAN0169 
TF A N0 1 70 


IF  (A8GT.LT. -20. ) GO  TO  76 
B-ALOG  (SZ 1/SZ2) /ALOG (T1/T2) 

EXZ1-EXP(-(  (HEFF-HRECPT)/SZ2) **2/2.) 

EXZ2*BXP (- ( (HEFF+HR ECPT)/SZ2) **2/2 . ) 
EXT-EXP(ARGY) 

IF  (ABS(I.-B) .LE. .001)  GO  TO  2 
FCMX*  (T2/SZ 2-T1/SZ1) *3600 ./ ( 1 . -B) 

GO  TO  3 

c 

C SPECIAL  CASE  FOR  B * 1. 

C 

2 FCRX°T1/SZ1 *ALOG (T2/T1) *3600. 

C 

3 TBAR*BXT» (BXZ1+EXZ2) *FCHX/ (6. 2831853*ST*DEH) 
IBACR-0 

RETORR 

ERD 


T*A  R0 1 86 
TRAR0187 
TRAR0188 
*R»»0189 
TRM0190 
?R*R01«1 
TPAR0192 
TPAR0193 

Aw01  95 
TPARM96 
T* ARO 197 
7RAP0198 
TRAR0199 
■’•RAR0200 
TRAR0201 
TPP>*0202 
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